SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00036 SOUNDBLASTER/ADLIB/SPEAKER ROUTINES 1 05-28-9313:57ALL SWAG SUPPORT TEAM ALLNOTES.PAS IMPORT 25 ■"╬ {π> Anyone out there ever bothered to fing out what numbers make which note,π> eg. does any know if Sound(3000) makes an A, a C, D#, or what? I'd likeπ> to know as many as possible, hopefully With the middle C on a piano asπ> one of them.π}ππConstπ Notes : Array[1..96] Of Word =π { C C#,D- D D#,E- E F F#,G- G G#,A- A A#,B- B }π (0033, 0035, 0037, 0039, 0041, 0044, 0046, 0049, 0052, 0055, 0058, 0062,π 0065, 0069, 0073, 0078, 0082, 0087, 0093, 0098, 0104, 0110, 0117, 0123,π 0131, 0139, 0147, 0156, 0165, 0175, 0185, 0196, 0208, 0220, 0233, 0247,π 0262, 0277, 0294, 0311, 0330, 0349, 0370, 0392, 0415, 0440, 0466, 0494,π 0523, 0554, 0587, 0622, 0659, 0698, 0740, 0784, 0831, 0880, 0932, 0987,π 1047, 1109, 1175, 1245, 1329, 1397, 1480, 1568, 1661, 1760, 1865, 1976,π 2093, 2217, 2349, 2489, 2637, 2794, 2960, 3136, 3322, 3520, 3729, 3951,π 4186, 4435, 4699, 4978, 5274, 5588, 5920, 6272, 6645, 7040, 7459, 7902);ππ{πEach line represents one octave, starting With octave 0. Middle C is 523Hz andπMiddle A is 440 (middle A is what all other note calculations are besed on;πeach note it the 12th root of 2 times the previous one.) You should be able toπarrange the Array into two dimensions if you want to access it using an octaveπand note #.π}ππ{πHere are the notes..ππ C0 16.35 C2 65.41 C4 261.63 C6 1046.50π C#0 17.32 C#2 69.30 C#4 277.18 C#6 1108.73π D0 18.35 D2 73.42 D4 293.66 D6 1174.66π D#0 19.45 D#2 77.78 D#4 311.13 D#6 1244.51π E0 20.60 E2 82.41 E4 329.63 E6 1328.51π F0 21.83 F2 87.31 F4 349.23 F6 1396.91π F#0 23.12 F#2 92.50 F#4 369.99 F#6 1479.98π G0 24.50 G2 98.00 G4 392.00 G6 1567.98π G#0 25.96 G#2 103.83 G#4 415.30 G#6 1661.22π A0 27.50 A2 110.00 A4 440.00 A6 1760.00π A#0 29.14 A#2 116.54 A#4 466.16 A#6 1864.66π B0 30.87 B2 123.47 B4 493.88 B6 1975.53π C1 32.70 C3 130.81 C5 523.25 C7 2093.00π C#1 34.65 C#3 138.59 C#5 554.37 C#7 2217.46π D1 36.71 D3 146.83 D5 587.33 D7 2349.32π D#1 38.89 D#3 155.56 D#5 622.25 D#7 2489.02π E1 41.20 E3 164.81 E5 659.26 E7 2637.02π F1 43.65 F3 174.61 F5 698.46 F7 2793.83π F#1 46.25 F#3 185.00 F#5 739.99 F#7 2959.96π G1 49.00 G3 196.00 G5 783.99 G7 3135.96π G#1 51.91 G#3 207.65 G#5 830.61 G#7 3322.44π A1 55.00 A3 220.00 A5 880.00 A7 3520.00π A#1 58.27 A#3 233.08 A#5 932.33 A#7 3729.31π B1 61.74 B3 246.94 B5 987.77 B7 3951.07π} C8 4186.01πππ 2 05-28-9313:57ALL SWAG SUPPORT TEAM DETCADLB.PAS IMPORT 13 ■"║ Usesπ Crt; (* Crt Needed For Delay Routine *)ππFunction AdlibCard : Boolean;π (* Routine to determine if a Adlib compatible card is installed *)πVarπ Val1,Val2 : Byte;πbeginπ Port[$388] := 4; (* Write 60h to register 4 *)π Delay(3); (* Which resets timer 1 and 2 *)π Port[$389] := $60;π Delay(23);π Port[$388] := 4; (* Write 80h to register 4 *)π Delay(3); (* Which enables interrupts *)π Port[$389] := $80;π Delay(23);π Val1 := Port[$388]; (* Read status Byte *)π Port[$388] := 2; (* Write ffh to register 2 *)π Delay(3); (* Which is also Timer 1 *)π Port[$389] := $FF;π Delay(23);π Port[$388] := 4; (* Write 21h to register 4 *)π Delay(3); (* Which will Start Timer 1 *)π Port[$389] := $21;π Delay(85); (* wait 85 microseconds *)π Val2 := Port[$388]; (* read status Byte *)π Port[$388] := 4; (* Repeat the first to steps *)π Delay(3); (* Which will reset both Timers *)π Port[$389] := $60;π Delay(23);π Port[$388] := 4;π Delay(3);π Port[$389] := $80; (* Now test the status Bytes saved *)π If ((Val1 And $e0) = 0) And ((Val2 And $e0) = $c0) Thenπ AdlibCard := True (* Card was found *)π Elseπ AdlibCard := False; (* No Card Installed *)πend;ππbeginπ ClrScr; (* Clear the Screen *)π Write(' Adlib Card '); (* Prepare Response *)π If AdlibCard Thenπ Writeln( 'Found!') (* There is one *)π Elseπ Writeln('Not Found!'); (* Not! *)πend.π 3 05-28-9313:57ALL SWAG SUPPORT TEAM MODMUSIC.PAS IMPORT 30 ■"V· MOD File DEMOπππ ST> I do, however, have the MOD File structures in a Text File.π ST> NetMail if you want them.ππ EW> Hey.. Could you post them here if their not too long?π EW> All I have For MOD Files is a Program (so so) that plays themπ EW> through the PCSpeaker, and it's *ALL* in Asm, and I'd loveπ EW> to be able to convert at least the File reading to pascal,ππ The MOD File Format is not overly Complicated in itself, but the musicπ encoded therein is very intricate, since the notes use non-standardπ notations For the frequency, and the effects For each note are veryπ involved. I can, however, post a good skeleton For the File structure,π but if you want the effects commands, we'll have to go to NetMail,π since it would not be in Pascal.ππType SongNameT = String[20]; {This is the first structure in the File, theπ full name of the song in the File}π SampleT = Record {This structure is Repeated 31 times, andπ describes each instrument}π Name : String[22];π Len : Word; {Length of the sample wave pattern, which isπ Near the end of the File. This number isπ the number of Words, use MUL 2 For Bytes}π FineTune : Byte; {0-7 = 0 to +7, 8-F = -8 to -1 offset fromπ normal played notes. Useful For off-keyπ instruments}π Volume : Byte; {0-64 Normal volume of instrument}π RepeatAt : Word; {offset in Words of the start of the patternπ Repeat For long notes.}π RepeatLn : Word; {Length in Words of the Repeated part of theπ sample pattern}π end;ππ VoiceT = Record {This structure is not in the MOD File itself, butπ should help in organizing all of the voice'sπ Charicteristics}π Sample : Byte; {0-31 Which instrument sample to play}π note : Word; {12 bits Which note. Non-standard strange numbers}π Effect : Byte; {0-F Effect to use on note}π EffectC : Byte; {00-FF Control Variable to effect}π end;ππ SongDataT = Record {This Record, at offset 950, contains inFormationπ about the song music itself}π SongLength : Byte; {1-128 Number of patterns (not wave) ofπ sets of musical notes}π Fill1 : Byte; {Set to 127}π Patterns : Array[0..127] of Byte; {0-63 Outline of song}π {Tells which score to play where. Number ofπ patterns is the highest number here}π Initials : String[4]; {"M.K.","FLT4", or "FLT8"}π end;ππ PatternDataT = Array[1..4] of Byte; {This structure is Repeatedπ four times For each note in the score (4 voices,π 4 Bytes each}ππ {After this the wave patterns For the samples are placed}ππVar Voice : Array[1.. 4] of VoiceT; {Four voices}π Sample : Array[1..31] of SampleT; {31 samples}ππProcedure ParseData (Patt : PatternDataT, VoiceNum : Byte);π{Stuffs voice With pattern data beFore playing}πbeginπ Voice[VoiceNum].Sample := (Patt[1] mod 16) shl 4 + (Patt[3] mod 16);π Voice[VoiceNum].note := (Patt[2] shl 4) + (Patt[2] div 16);π Voice[VoiceNum].Effect := (Patt[3] div 16;π Voice[VoiceNum].EffectC := Patt[4];π end;ππAnyway, this should help explain how to do something With the File.πif you need inFormation on what the numbers For the notes are or howπto interprit the effects, send NetMail.π 4 05-28-9313:57ALL SWAG SUPPORT TEAM MUSCNOTE.PAS IMPORT 21 ■"±┌ {π> Does anyone have a "musical scale" of all the values With the Soundπ> Function? A friend is writing a "happy birthday" Program and wants toπ> get a list of all the notes without actually testing them (G)ππ{ Here's a handy Unit that takes a lot of work out of playing music. }π{ I think it originally came from this echo. }ππUnit Music;πInterfaceπUses Crt;πConstπ e_note = 15; { Eighth Note }π q_note = 30; { Quarter Note }π h_note = 60; { Half Note }π dh_note = 90; { Dotted Half Note }π w_note = 120; { Whole Note }π R = 0; { Rest }π C = 1; { C }π Cs = 2; { C Sharp }π Db = 2; { D Flat }π D = 3; { D }π Ds = 4; { D Sharp }π Eb = 4; { E Flat }π E = 5; { Etc... }π F = 6;π Fs = 7;π Gb = 7;π G = 8;π Gs = 9;π Ab = 9;π A = 10;π As = 11;π Bb = 11;π B = 12;ππProcedure PlayTone(Octave : Byte; Note : Byte; Duration : Word);πProcedure ToneOn(Octave : Byte; Note : Byte);ππImplementationππVarπ Oct_Val : Array [0..8] Of Real;π Freq_Val : Array [C..B] Of Real;ππProcedure Set_Frequencies;πVar N : Byte;πbeginπ Freq_Val[1] := 1;π For N := 2 To 12 Doπ Freq_Val[N] := Freq_Val[N-1] * 1.0594630944;π Oct_Val[0] := 32.70319566;π For N := 1 To 8 Doπ Oct_Val[N] := Oct_Val[N-1] * 2;πend;ππProcedure PlayTone(Octave : Byte;π Note : Byte;π Duration : Word);πbeginπ If Note = R Thenπ NoSoundπ Elseπ Sound(Round(Oct_Val[Octave] * Freq_Val[Note]));π Delay(Duration*8);π NoSound;πend;ππProcedure ToneOn(Octave : Byte;π Note : Byte);πbeginπ If Note = R Then NoSoundπ Else Sound(Round(Oct_Val[Octave] * Freq_Val[Note]));ππend;ππbeginπSet_Frequencies;πNoSound;πend.πππ{πSomeone else: Here they are:ππConstπ C = 2093;π C# = 2217;π D = 2349;π D# = 2489;π E = 2637;π F = 2794;π F# = 2960;π G = 3136;π G# = 3322;π A = 3520;π A# = 3729;π H = 3951;ππThe next C is 2*2093, the C below is 2093 div 2 etc. pp.π}ππ{ππHere's an octive:π C = 262;π CSHARP = 277;π D = 294;π DSHARP = 311;π E = 330;π F = 349;π FSHARP = 370;π G = 392;π GSHARP = 415;π A = 440;π ASHARP = 466;π B = 494;π CC = 523;π} 5 05-28-9313:57ALL SWAG SUPPORT TEAM PIANO.PAS IMPORT 33 ■"c {πBILL BUCHANANππ> I'm just learning Pascal, and I was 1dering if it's possible 2 playπ> music in Pascal? if so... how?ππHere's a little Program that allows you to play the "PIANO" on your keyboard.πNo Soundcard needed or anything like that. This may give you a small ideaπon how to create your own Sounds ...ππ}ππProgram Music; {by Judy Birmingham, 9/18/92}πUsesπ Crt;ππConstπ {-------------------------------------------------------------------}π {These values will Vary by the song you choose}π {I wish I could have made these Variables instead of Constants,π but I seemed to be locked into using Const, because they defineπ Array sizes in the Types declared below.}ππ TotalLinesInSong = 4; {Number of lines in song}π MaxNotesInPhrase = 9; {Max number of notes in any line}π BeatNote = 4; {Bottom number in Time Signature}π {Handles cut time (2/2), 6/8 etc.}π Tempo = 160; {Number of beats per minute}π {-------------------------------------------------------------------}π {Note frequencies}π R = 0; {Rest = frequency of 0 : silence}π C = 260; {Frequency of middle c }π CC = 277; {Double letter indicates a sharp}π D = 294;π DD = 311;π E = 330;π F = 349;π FF = 370;π G = 392;π GG = 415;π A = 440;π AA = 466;π B = 494;ππ {Note durations}π Q = 1 * (BeatNote/4); {Quarter note}π I = 0.5 * (BeatNote/4); {Eighth note}π H = 2 * (BeatNote/4); {Half note}π W = 4 * (BeatNote/4); {Whole note}π S = 0.25 * (BeatNote/4); {Sixteenth note}π DQ = 1.5 * (BeatNote/4); {Dotted quarter}π DI = 0.75 * (BeatNote/4); {Dotted eighth}π DH = 3 * (BeatNote/4); {Dotted half}π DS = 0.375 * (BeatNote/4); {Dotted sixteenth}ππ Beat = 60000/Tempo; {Duration of 1 beat in millisecs}ππTypeπ IValues = Array [1..MaxNotesInPhrase] of Integer;π RValues = Array [1..MaxNotesInPhrase] of Real;π Phrase = Recordπ Lyric : String;π Notes : IValues; {Array of note frequencies}π Octave : IValues; {Array of note octaves}π Rhythm : RValues; {Array of note durations}π end;π Song = Array [1..TotalLinesInSong] of Phrase;ππ {Sample song}πConstπ RowRow : Song = (π (Lyric : 'Row Row Row Your Boat';π NOTES : (C,C,C,D,E,R,0,0,0);π OCTAVE : (1,1,1,1,1,1,0,0,0);π RHYTHM : (DQ,DQ,Q,I,Q,I,R,0,0)π ),ππ (Lyric : 'Gently down the stream';π NOTES : (E,D,E,F,G,R,0,0,0);π OCTAVE : (1,1,1,1,1,1,0,0,0);π RHYTHM : (Q,I,Q,I,DQ,DQ,0,0,0)π ),ππ (Lyric : 'Merrily merrily merrily merrily';π NOTES : (C,C,G,G,E,E,C,C,0 );π OCTAVE : (2,2,1,1,1,1,1,1,0 );π RHYTHM : (Q,I,Q,I,Q,I,Q,I,0 )π ),ππ (Lyric : 'Life is but a dream.';π NOTES : (G,F,E,D,C,R,0,0,0 );π OCTAVE : (1,1,1,1,1,1,0,0,0 );π RHYTHM : (Q,I,Q,I,H,Q,0,0,0 )π ));ππProcedure LYRICS(THE_WORDS : String);πbeginπ Writeln(THE_WORDS);πend;ππProcedure PLAYNOTE (NOTE, OCT: Integer; DURATION : Real);πbeginπ Sound (NOTE * OCT);π Delay (Round(BEAT * DURATION));π NoSound;πend;ππProcedure PLAYPHRASE(N : Integer; NOTES, OCTAVE : IValues; RHYTHM : RValues);πVarπ INDEX : Integer;πbeginπ For INDEX := 1 to N doπ PLAYNOTE (NOTES[INDEX], OCTAVE[INDEX], RHYTHM[INDEX]);πend;ππProcedure PLAYSONG (Title : String; Tune : Song);πVarπ Counter : Integer;πbeginπ ClrScr;π GotoXY(11,3);π Writeln (Title);π Window (10,5,70,19);π ClrScr;π For counter := 1 to TotalLinesInSong doπ beginπ LYRICS(Tune[counter].Lyric);π PLAYPHRASE(MaxNotesInPhrase, Tune[counter].Notes,π Tune[counter].Octave, Tune[counter].Rhythm);π end;πend;ππbeginπ ClrScr;π PlaySong('"Row Row Row Your Boat "', RowRow);πend.π 6 05-28-9313:57ALL SWAG SUPPORT TEAM PLAYMUSC.PAS IMPORT 16 ■"
x { Here is a Unit that plays music. It came out of this echo recently. }πππUnit Music;ππInterfaceππUsesπ Crt;πConstπ e_note = 15; { Eighth Note }π q_note = 30; { Quarter Note }π h_note = 60; { Half Note }π dh_note = 90; { Dotted Half Note }π w_note = 120; { Whole Note }π R = 0; { Rest }π C = 1; { C }π Cs = 2; { C Sharp }π Db = 2; { D Flat }π D = 3; { D }π Ds = 4; { D Sharp }π Eb = 4; { E Flat }π E = 5; { Etc... }π F = 6;π Fs = 7;π Gb = 7;π G = 8;π Gs = 9;π Ab = 9;π A = 10;π As = 11;π Bb = 11;π B = 12;ππProcedure PlayTone(Octave : Byte; Note : Byte; Duration : Word);πProcedure ToneOn(Octave : Byte; Note : Byte);ππImplementationππVarπ Oct_Val : Array [0..8] Of Real;π Freq_Val : Array [C..B] Of Real;ππProcedure Set_Frequencies;πVarπ N : Byte;πbeginπ Freq_Val[1] := 1;π For N := 2 To 12 Doπ Freq_Val[N] := Freq_Val[N-1] * 1.0594630944;π Oct_Val[0] := 32.70319566;π For N := 1 To 8 Doπ Oct_Val[N] := Oct_Val[N-1] * 2;πend;ππProcedure PlayTone(Octave : Byte; Note : Byte; Duration : Word);πbeginπ If Note = R Thenπ NoSoundπ Elseπ Sound(Round(Oct_Val[Octave] * Freq_Val[Note]));π Delay(Duration*8);π NoSound;πend;ππProcedure ToneOn(Octave : Byte; Note : Byte);πbeginπ If Note = R Thenπ NoSoundπ Elseπ Sound(Round(Oct_Val[Octave] * Freq_Val[Note]));πend;ππbeginπ Set_Frequencies;π NoSound;πend.ππ{π This does not include the actual values of the tones, but it is stillπvery helpful (more so than if you had the actual freqencies). If you stillπwant the tones, just substitute the value For the tone into the Proceduresπthat play the tone.π} 7 05-28-9313:57ALL SWAG SUPPORT TEAM SB-VOC.PAS IMPORT 28 ■"æ▓ { JR> Well, Can you post the sorce code on how to play to the Sound blasterπ JR> Byte by Byte? I could probley find out after that!π JR> JamesππSure thing... this Program will load a File into memory then play it a Byteπat a time... It should be pretty self-explanatory.π}ππProgram rawdemo;ππUses Crt;ππ{$I-}ππConstπ fname = 'NELLAF.VOC'; { Can be any raw data File }π resetport = $226;π readport = $22A;π Writeport = $22C;π statusport = $22E;π dac_Write = $10;π adc_read = $20;π midi_read = $30;π midi_Write = $38;π speakeron = $D1;π speakeroff = $D3;ππFunction reset_dsp : Boolean;πVarπ count, bdum : Byte;πbeginπ reset_dsp := False;π port[resetport] := 1;π For count := 1 to 6 doπ bdum := port[statusport];π port[resetport] := 0;π For count := 1 to 6 doπ bdum := port[statusport];π Repeat Until port[statusport] > $80;π if port[readport] = $AA thenπ reset_dsp := True;πend;ππProcedure spk_on;πbeginπ Repeat Until port[Writeport] < $80;π port[Writeport] := $D1;πend;ππProcedure spk_off;πbeginπ Repeat Until port[Writeport] < $80;π port[Writeport] := $D3;πend;ππProcedure generic(reg,cmd:Integer; data:Byte);πbeginπ Repeat Until port[Writeport] < $80;π port[reg] := cmd;π Repeat Until port[Writeport] < $80;π port[reg] := data;πend;ππProcedure Write_dsp(data:Byte); Assembler;πAsmπ mov dx,$22Cπ mov cx,6 { Change either value of CX For }π@1:π in al,dxπ loop @1ππ mov al,10hπ out dx,alπ mov cx,36 { faster or slower playing. }π@2:π in al,dxπ loop @2ππ mov al,dataπ out dx,alπend;ππFunction read_dsp : Byte;πbeginπ Repeat Until port[Writeport] < $80;π port[Writeport] := $20;π Repeat Until port[statusport] > $80;π read_dsp := port[readport];πend;ππProcedure Write_midi(data:Byte);πbeginπ Repeat Until port[Writeport] < $80;π port[Writeport] := $38;π Repeat Until port[Writeport] < $80;π port[Writeport] := data;πend;ππFunction read_midi : Byte;πbeginπ Repeat Until port[Writeport] < $80;π port[Writeport] := $30;π Repeat Until port[statusport] > $80;π read_midi := port[readport];πend;ππFunction loadFile(Var buffer:Pointer; Filename:String) : Word;πVarπ fromf : File;π size : LongInt;π errcode : Integer;πbeginπ assign(fromf,Filename);π reset(fromf,1);π errcode := ioresult;π if errcode = 0 thenπ beginπ size := Filesize(fromf);π Writeln(size);π getmem(buffer,size);π blockread(fromf,buffer^,size);π endπ else size := 0;π loadFile := size;π close(fromf);πend;ππProcedure unload(buffer:Pointer; size:Word);πbeginπ freemem(buffer,size);πend;ππVarπ ch : Char;π buf : Pointer;π index, fsize : Word;ππbeginπ ClrScr;π Writeln;π Writeln;π if not reset_dsp thenπ beginπ Writeln('Unable to initialize SoundBlaster.');π halt(1);π end;π fsize := loadFile(buf,fname);π if (fsize <= 0) thenπ beginπ Writeln(fname, ' not found.');π halt(2);π end;π{ For index := 1 to fsize doπ dec(mem[seg(buf^):ofs(buf^)+index-1],80);} { For MOD samples }π spk_on;π Writeln('Playing...');π For index := 1 to fsize doπ Write_dsp(mem[seg(buf^):ofs(buf^)+index-1]);π spk_off;π unload(buf,fsize);π Writeln('Done.');π ch := ReadKey;πend.ππ 8 05-28-9313:57ALL SWAG SUPPORT TEAM SBDEMO.PAS IMPORT 5 ■"ñ½ {$M 16384,0,0}ππProgram Demo; { to demonstrate the SBVoice Unit }π { Copyright 1991 Amit K. Mathur, Windsor, Ontario }ππUses SBVoice;ππbeginπif SBFound then beginπ if paramcount=1 then beginπ LoadVoice(ParamStr(1),0,0);π sb_Output(seg(SoundFile),ofs(SoundFile)+26);π Repeatπ Write('Ha');π Until StatusWord=0;π end elseπ Writeln('Usage: DEMO [d:\path\]Filename.voc');π end elseπ Writeln('SoundBlaster Init Error. SoundBlaster v1.00 not Found.');πend.ππ 9 05-28-9313:57ALL SWAG SUPPORT TEAM SBVOICE.PAS IMPORT 78 ■"àe {---------------------------------------------------------------------------π Unit SBVoice (v1.10) For Turbo Pascal 6.0π For interfacing With the SoundBlaster's digitized voice channel.π Copyright (c) 1991, Amit K. Mathur, Windsor, Ontario.ππ By: Amit K. Mathurπ 3215 St. Patrick's Driveπ Windsor, Ontarioπ N9E 3H2 CANADAπ Ph: (519) 966-6924ππ Networks: RIME(tm) R/O ->WinDSor, ILink (Shareware), NA-Net (Gaming),π WWIVNet (#198@5950), or direct on NorthSTAR (519)735-1504.ππ These routines are released to the public domain. However I will gladlyπ accept contributions towards further development of this and other products.π Please send any changes or improvements my way. and I'm interested inπ other SoundBlaster utilities and Programming tools. Thanks in advance.π --------------------------------------------------------------------------}ππ{$O+,F+}π{ Allow this Unit to Be Overlayed (doesn't affect Compilation if you decideπ not to overlay it), and Force Far calls. }ππUnit SBVoice;ππInterfaceππUses MemAlloc; { Memory Allocation Proc }ππVarπ{$ifNDEF NoSBVoiceArray} { to use your own }π SoundFile: Array[1..64000] of Byte; { whatever size you want }π{$endif}π sgSBDriver, ofSBDriver: Word; { seg and ofs of Driver }π SBDriver: Pointer; { Pointer to the driver }π StatusWord: Word; { stores SB status }π SBFound: Boolean; { whether Init worked }ππProcedure loaddriver(fi:String);π{ Loads CT-VOICE.DRV into memory. 'fi' is the path to the driver. }ππProcedure closedriver;π{ Clean up routine. not Really necessary if your Program is over. }ππProcedure loadvoice(f:String;start,size:Word);π{ Load 'f' into memory. Start is the start of the area withinπ 'f' to load and size is the amount to laod. if you set size to 0π then it will load the entire File. }ππFunction sb_getversion:Integer;π{ Get the version number of the CT-VOICE.DRVπ Returns the Version number }ππFunction sb_init:Integer;π{ Initialize the SoundBlaster. Call this right after load driver, unlessπ you have to change the BaseIOAddress or Interrupt number and haven'tπ changed the CT-VOICE.DRV File itself.π Returns: 0 - no problemπ 1 - Sound card failiureπ 2 - I/O failiureπ 3 - DMA interrupt failiure }ππProcedure sb_output(sg,os:Word);π{ Output the digitized Sound. You must load the Sound first!π sg and os are the segment and offset of either SoundFile or whateverπ Array you use to store the Sound. if you use a .VOC File then callπ With 26 added to the offset. }ππProcedure sb_setstatusWord(sg,os:Word);π{ Sets the location of the status Word. This is the third thing you shouldπ do, after loading the driver and initializing it.π The StatusWord will contain $0FFFF if input/output is in output, andπ 0 when it's done. It will also hold the values of the markers in voiceπ Files if any are encounterred, allowing you to coordinate output withπ your Programs. }ππProcedure sb_speaker(mode:Word);π{ Set the speaker on/off. off is mode 0, and On is anything else. Thisπ is the fourth thing you should do in your initialization. }ππProcedure sb_uninstall;π{ Uninstall the driver from memory. Used by CloseDriver. }ππProcedure sb_setIOaddress(add:Word);π{ Override the IOaddress found inside the CT-VOICE.DRV File. Add is theπ new IO address. }ππProcedure sb_setinterruptnumber(intno:Word);π{ Allows you to override the Interrupt number in the driver. IntNo is yourπ new interrupt number (3, 5, 7 or 9). }ππProcedure sb_stopoutput;π{ Stops the output in progress }ππFunction sb_pauseoutput: Integer;π{ PaUses the output in progress.π Returns: 0 - successπ 1 - fail }ππFunction sb_continueoutput: Integer;π{ Continues a paused output.π Returns: 0 - successπ 1 - fail (nothing to continue) }ππFunction sb_breakloop(mode:Word): Integer;π{ Breaks out of the currect output loop.π Modes: 0 - continue round, stop when doneπ 1 - stop immediatelyπ Returns: 0 - successπ 1 - not in loop }ππProcedure sb_input(highlength,lowlength,seginputbuff,ofsinputbuff:Word);π{ Input digitized Sound.π HighLength: The high Byte of the length of the input buffer.π LowLength: The low Byte of the length of the input buffer.π SegInputBuff: The Segment of the start of the input buffer.π ofsInputBuff: The offset of the start of the input buffer. }ππProcedure sb_setuserFunction(segaddress,ofsaddress:Word);π{ Sets up a user Function that the SB calls when it encounters a new dataπ block. It must perForm a Far ret, preserve DS,DI,SI and flag register.π Clear Carry flag if you want the driver to process the block, or set itπ if your routine will. It must be clear if the block Type is 0, thatπ is the terminate block.π SegAddress is the segment of your user Function in memory.π ofsAddress is the ofset of your user Function in memory. }ππImplementationππUses Dos;ππProcedure Abort(s:String);πbeginπ Writeln('The Following Error Has Occurred: ',s);π Writeln('Remedy and try again. We apologize For any inconvenience.');π halt(1);πend;ππProcedure loaddriver(fi:String);πVar f: File;π k: Integer;π t: String[8];πbeginπ assign(f,fi+'CT-VOICE.DRV');π {$I-} Reset(f,1); {$I+}π if Ioresult <> 0 thenπ Abort('Cannot Open '+fi+'CT-VOICE.DRV');π blockread(f,Mem[sgSBDriver:ofSBDriver],Filesize(f));π close(f);π t:='';π For k:=0 to 7 doπ t:=t+chr(Mem[sgSBDriver:ofSBDriver+k+3]);π if t<>'CT-VOICE' thenπ abort('Invalid CT-VOICE Driver!');πend;ππProcedure closedriver;πbeginπ sb_uninstall;π if dalloc(sbdriver)=0 thenπ abort('Uninstall Error!');πend;ππProcedure loadvoice(f:String;start,size:Word);πVar fi: File;π k: Word;πbeginπ assign(fi,f);π {$I-} Reset(fi,1); {$I+}π if Ioresult <> 0 thenπ abort('Cannot Open '+f+'!');π k:=0;π seek(fi,start);π if size=0 then size:=Filesize(fi);π blockread(fi,Mem[seg(SoundFile):ofs(SoundFile)],size);π close(fi);πend;ππFunction sb_getversion: Integer; Assembler;πAsmπ push bpπ mov bx,0π call SBDriverπ pop bpπend;ππProcedure sb_setIOaddress(add:Word); Assembler;πAsmπ push bpπ mov bx,1π mov ax,addπ call SBDriverπ pop bpπend;ππProcedure sb_setinterruptnumber(intno:Word); Assembler;πAsmπ push bpπ mov bx,2π mov ax,intnoπ call SBDriverπ pop bpπend;ππProcedure sb_stopoutput; Assembler;πAsmπ push bpπ mov bx,8π call SBDriverπ pop bpπend;ππFunction sb_init: Integer; Assembler;πAsmπ push bpπ mov bx, 3π call SBDriverπ pop bpπend;ππFunction sb_pauseoutput: Integer; Assembler;πAsmπ push bpπ mov bx,10π call SBDriverπ pop bpπend;ππFunction sb_continueoutput: Integer; Assembler;πAsmπ push bpπ mov bx,11π call SBDriverπ pop bpπend;ππFunction sb_breakloop(mode:Word): Integer; Assembler;πAsmπ push bpπ mov bx,12π mov ax,modeπ call SBDriverπ pop bpπend;ππProcedure sb_output(sg,os:Word); Assembler;πAsmπ push bpπ push diπ mov bx,6π mov di,os { offset of voice }π mov es,sg { segment of voice }π call SBDriverπ pop diπ pop bpπend;ππProcedure sb_input(highlength,lowlength,seginputbuff,ofsinputbuff:Word);πAssembler;πAsmπ push bpπ push diπ mov bx,7π mov dx,highlengthπ mov cx,lowlengthπ mov es,seginputbuffπ mov di,ofsinputbuffπ call SBDriverπ pop diπ pop bpπend;ππProcedure sb_setstatusWord(sg,os:Word); Assembler;πAsmπ push bpπ push diπ mov bx,5π mov di,osπ mov es,sgπ call SBDriverπ pop diπ pop bpπend;ππProcedure sb_speaker(mode:Word); Assembler;πAsmπ push bpπ mov bx,4π mov ax,modeπ call SBDriverπ pop bpπend;ππProcedure sb_uninstall; Assembler;πAsmπ push bpπ mov bx,9π call SBDriverπ pop bpπend;ππProcedure sb_setuserFunction(segaddress,ofsaddress:Word); Assembler;πAsmπ push bpπ mov dx,segaddressπ mov ax,ofsaddressπ mov bx,13π call SBDriverπ pop bpπend;πππbegin {set up SB}ππ if DosMemAvail < 5000 then { lower the heap }π abort('not Enough Memory'); { With $M to fix }π StatusWord:=MAlloc(SBDriver,5000);π if StatusWord<>0 thenπ abort('Memory Allocation Error');ππ sgSBDriver:=MemW[seg(SBDriver):ofs(SBDriver)+2];π ofSBDriver:=MemW[seg(SBDriver):ofs(SBDriver)];ππ Loaddriver(''); { change at will }π if sb_init<>0 then { or stick in your }π SBFound:=False { own Program init }π elseπ SBFound:=True;ππ if SBFound then beginπ sb_setstatusWord(seg(statusWord),ofs(statusWord));π sb_speaker(1); { turn SB on }π end;πend.πππ{There's the Unit For .VOC playing.}π 10 05-28-9313:57ALL SWAG SUPPORT TEAM SOUNDINF.PAS IMPORT 96 ■"0 {πJOE DICKSONππ> Hello there.. I was just wondering if anyone had any ideaπ> on how to play a wav/voc File over the pc speaker. I have aπ> Program called PC-VOICE, written by Shin K.H. (Is he here?)π> that will play voc's and wav's (whats the difference?) overπ> the speaker.. I don't know assembly, just pascal, but I'veπ> got a friend that can show me how to link the assembly stuffπ> in With the Pascal, so that shouldn't be a problem..π> Also, I've tried and failed to find the format of a voc/wavπ> File, so if anyone has that, it would be much appriciated.π}ππHeader-- CT-VOICE Header Blockπ-=-πThe header is a data block that identifies the File as a CT-format File. Thisπmeans that you can use the header to check whether the File is an actualπCT-format File.ππBytes $00 - $13 (0-19)ππThe first 19 Bytes of a VOC File contain the Text "Creative Voice File", asπwell as a Byte With the value $1A. This identifies the File as a VOC File.ππBytes $14 - $15 (20-21)ππThese Bytes contain the offset address of the sample data as aπlow-Byte/high-Byte value. At this point, this value is $001A because theπheader is exactly $1A Bytes long.ππHowever, if the length of the header changes later, the Programs that accessπthe VOC data in this File will be able to use the values stored in these twoπBytes to determine the location at which the sample data begins.ππBytes $16 - $17 (22-23)ππThese two Bytes contain the CT-Voice format version number as aπlow-Byte/high-Byte value. The current version number is still 1.10 (NOTE--Thisπmay have changed, this was published in 92) so Byte $17 contains the mainπversion number ($01) and Byte $16 contains the version subnumber ($0A). Theπversion number is very important because later CT-Voice format versions may useπan entirely different method For storing the sample data than the currentπversion.ππTo ensure that the data contained in the File will be processed correctly, youπshould always check the File's version number. if a different version numberπappears, an appropriate warning should be displayed.ππBytes $18 - $19 (24-25)ππThe importance of the version number is obvious in Bytes $18 and $19. TheseπBytes contain the complement of the version number, added to $1234, as aπlow-Byte/high-Byte value.ππTherefore, With the current version number $010A, Byte $18 contains the valueπ$29, While Byte $19 contains $11. This results in the Word value $1129. Ifπyou check this value and succesfully compare it to the version number stored inπthe previos two Bytes, you can be almost certain that you're using a VOC File.ππThis completes the desciprtion of Bytes contained in the header. Everythingπthat follows these Bytes in the File belongs to the File's data blocks.ππThe Data Blocks-- The eight data blocks of the CT-Voice format have the sameπstructure, except For block 0. Each block begins With a block identifier,πwhich is a Byte containing a block-Type number between 0 and 7. This number isπfollowed by three Bytes specifying the length of the block, and then theπspecified number of additional data.ππThe three length Bytes contain increasing values (i.e., the first Byteπrepresents the lowest value and the third Byte represents the highest). SO theπblock's length can be calculated by using the formula:ππByte1 + Byte2*256 + Byte3*65536ππIn all other cases, the CT-Voice format stores values requiring more than oneπByte in a low Byte followed by a high-Byte, which corresponds to the Word dataπType.ππBlock 0 - end BlockππThe end block has the lowest block number. It indicates that there aren't anyπadditional data blocks. When such a block is reached, the output of VOC dataπduring the playback of digitized Sounds stops. Therefore, this block should beπlocated only at the end of a VOC File. The end block is the only block thatπdoesn't have Bytes indicating its block length.ππ+----------------------------+π| STRUCTURE of THE end BLOCK |π| |π| Block Type: 1 Byte = 0 |π| Block Length: None |π| Data Bytes: None |π+----------------------------+ππBlock 1 - New Voice BlockππThe block Type number 1 is the most frequently used block Type. It containsπplayable sample data. The three block length Bytes are followed by a Byteπspecifying the sampling rate (SR) that was used to Record the Sounds.ππCalculatin The Sampling Rate-- Since only 256 different values can be stored inπa singly Byte, the actual sampling rate must be calculated from the value ofπthis Byte.ππUse the following formula to do this:ππ Actual_sampling_rate = -1000000 div (SR - 256)ππTo convert a sampling rate into the corresponding Byte value, reverse theπequation:ππ SR = 256 - 1000000 div actual_sampling_rateππThe pack Byte follows the SR Byte. This value indicates whether and how theπsample data have been packed.ππThe value 0 indicates that the data hasn't been packed; so 8 bits form one dataπvalue. This is the standard Recording format. However, your Sound Blasterπcard is also capable of packing data on a hardware level. (good luck trying toπrecreate that)ππA value of 1 in the pack Byte indicates that the original 8 bit values haveπbeen packed to 4 bits. This results in a pack rate of 2:1. Although the dataπrequires only half as much memory, this method also reduces the Sound quality.ππThe value 2 indicates a pack rate of 3:1, so the data requires only a third ofπthe memory. Sound quality reduces significantly.ππA pack Byte value of 3 indicates a pack rate of 4:1, so 8 original bits haveπbeen packed down to 2. This pack rate results in A LOT of reduction in Soundπquality.ππThe pack Byte is followed by the actual sample data. The values contained inπthe block length Bytes also indicate the length of the sample data. Toπdetermine the length of the actual sample data in Bytes, simply subtract the SRπand pack Bytes from the block length.ππ+---------------------------------+π| STRUCTRE of THE NEW VOICE BLOCK |π| |π| Block Type: 1 Byte = 1 |π| Block Length: 3 Bytes |π| SR Byte: 1 Byte |π| Pack Byte: 1 Byte = 0,1,2,3 |π| Data Bytes: X Bytes. |π+---------------------------------+ππBlock 2 - Subsequent Voice BlockππBlock Type 2 is used to divide sample data into smaller individual blocks. Thisπmethod is used by the Creative Labs Voice Editor when you want to work With aπsample block that's too large to fit into memory in one piece. This block isπthen simply divided into several smaller blocks.ππSince these blocks contain only three length Bytes and the actual sample data,πblocks of Type 2 must always be preceded by a block of Type 1. So, theπsampling rate and the pack rate are determined by the preceeding block Type 1.ππ+-----------------------------------------+π| STRUCTURE of THE SUBSEQUENT VOICE BLOCK |π| |π| Block Type: 1 Byte = 2 |π| Block Length: 3 Bytes |π| Data Bytes: X Bytes |π+-----------------------------------------+ππBlock 3 - Silence BlockππBlock Type 3 Uses a small number of Bytes to represent a mass of zeros. Firstπthere are the three familiar block length Bytes. The length of a silence blockπis always 3, so the lowest Byte contains a three, and then the other two Bytesπcontain zeros.ππThe length Bytes are followed by two other Bytes, which indicate how many zeroπBytes should be replaced by the silence block.ππThis is followed by a Byte that indicates the sampling rate For the silenceπblock. The SR Byte is encoded in the same way as indicated in block Type 1.ππSilence blocks can be used to insert longer paUses or silences in a sample,πwhich reduces the required data to a few Bytes. The Voice Editor will insertπthese silence blocks through the Silence Packing Function.ππ+--------------------------------+π| STRUCTURE of THE SILENCE BLOCK |π| |π| Block Type: 1 Byte = 3 |π| Block Length: 3 Bytes = 3 |π| Duration: 2 Bytes |π| Sample Rate: 1 Byte |π+--------------------------------+ππBlock 4 - Marker BlockππThe marker block is an important element of the CT-Voice format. It also hasπthree block length Bytes followed by two marker Bytes. The block length Bytesπalways contain the value 2 in the lowest Byte.ππWhen the playback routine of "CT-VOICE.DRV" encounters a marker block, theπvalue of the marker Byte is copied to a memory location that was specified toπthe driver. The marker block is often used to determine where exactly inπplayback you are. This is useful For synchronizing the action of your Programπwith the playback, For a Graphical intro For example.ππUsing the Voice Editor, you can divide large sample data blocks into smallerπones, inserting marker blocks at important locations. This doesnt affect theπplayback of the sample. However, you'll be able to determine, from yourπProgram, which point of the sample the playback routine is currently reading.ππ+-------------------------------+π| STRUCTURE of THE MARKER BLOCK |π| |π| Block Type : 1 Byte = 4 |π| Block Length: 3 Bytes = 2 |π| Marker: 2 Bytes |π+-------------------------------+ππBlock 5 - Message BlockππIt's also possible to insert ASCII Texts Within a VOC File. Use the messageπblock to do this. if you want to identify a specific seciont of a sample Fileπby adding a title, simply add a block of Type 5, in which you can then storeπthe desired Text.ππThis block also has three block length Bytes. These Bytes are followed by theπText in ASCII format. The Text must contain a 0 in the last Byte to indicateπthe end of the Text. This corresponds to the String convention of the CπProgramming language. This allows you to pring the Texts in a VOC Fileπdirectly from memory using the printf() Function in ANSI C.ππ+--------------------------------+π| STRUCTURE of THE MESSAGE BLOCK |π| |π| Block Type: 1 Byte = 5 |π| Block Length: 3 Bytes |π| ASCII Data: X Bytes |π| end Character: 1 Byte = 0 |π+--------------------------------+ππBlock 6 - Repeat BlockππAnother special Characteristic of the CT-Format is that it's possible toπspecify, Within a VOC File, whether specific sample sequences should beπRepeated. Blocks 6 and 7 are used to do this.ππBlock 6 has three block length Bytes, followed by two Bytes indicating howπoften the following data block should be Repeated. if the value specified hereπis 4, the next block is played a total of five times (one "normal" playback andπfour Repeats).ππ+-------------------------------+π| STRUCTURE of THE Repeat BLOCK |π| |π| Block Type: 1 Byte = 6 |π| Block Length: 3 Bytes = 2 |π| Counter: 2 Bytes |π+-------------------------------+ππBlock 7 - Repeat end BlockππBlock 7 indicates that all blocks between block 6 and block 7 should beπRepeated. With this block, several data blocks can be included in a Repeatπloop. However, nested loops aren't allowed. The driver is capable of handlingπonly one loop level.ππBlock Type 7 also has three block length Bytes, which actually aren't necessaryπbecause this block doesnt contain any additional data. Therefore, the blockπlength is always 0.ππ+-------------------------------+π| STRUCUTRE of Repeat end BLOCK |π| |π| Block Type: 1 Byte = 7 |π| Block Length: 3 Bytes = 0 |π+-------------------------------+ππWe've now described all the different block Types used in VOC Files. TheseπFunctions are fully supported by the CT-VOICE.DRV driver software.ππif you'll be writing your own Sound Programs, you should follow this formatπbecause it's easy to use and flexible. When needed, new block Types are easilyπadded. Programs that dont recognize block Types should be written so theyπcontinue operating after an unrecognized block. This is easy to do becauseπeach Function specifies its own block length.ππBiblioGraphy: Stolz, Axel "The Sound Blaster Book", Abacus Copyright (c)1992,πA Data Decker Book Copyright (c) 1992ππ 11 05-28-9313:57ALL SWAG SUPPORT TEAM SOUNDOFF.PAS IMPORT 10 ■"É╞ {πSTEVEN TALLENTππ> I am look For a piece of code [...] that will turn off the speaker.ππThis is tested code, and should do the trick. It does its work byπturning off the PC speaker 18.2 times per second. This should reduceπany Sound to maybe a click or two. Unfortunately, some games andπmusic software will bypass it (ModPlay, Wolfenstein), but most beepsπand whistles will be gone. This is a TSR Program, and takes about 3kπmemory (yuk), but you can load it high if you want. I've found itπespecially useful during late-night BBSing (no alarms at connect/Fileπxfer finish). Hope this does the trick! Considering its size andπrelative isolation from normal Programs, I didn't see fit to use CLI/STI.π}ππ{$M 1024,0,0} {BTW, is there any way to make this smaller?!?}π{$N-,S-,G+} { Use g- For 8088 systems, g+ For V20 and above }πProgram NoSpeak;πUsesπ Dos;ππProcedure ShutOff; INTERRUPT;πbeginπ Port [97] := Port[97] and 253; {Turn off speaker and disconnect timer}πend;ππbeginπ SetIntVec( $1C, @ShutOff);π Keep(0);πend.ππ 12 05-28-9313:57ALL SWAG SUPPORT TEAM VOC2LPT1.PAS IMPORT 14 ■"Ç {π This is a Program to export a VOC or other Raw Sound File to a Parallelπport DAC.. (only For LPT1 now, but i think you can make it work on LPT2 byπchanging the 'PORT[$0378]' to 'PORT[$0388]'...ππ I know, This is a Real mess For figuring it out... I originally had noπintention of posting it, but I believe in free access to info, so here it is!πIf you have any questions about it, just ask... and if you figure out whereπthat bug is (you'll know what I mean, it only plays PART of the VOC) I'dπappreciate input.π}ππ{This Program Assumes you have a DAC on LPT1}π{$M 65520,0,300000} {only use memory that is needed}πProgram Voc_Play;πUsesπ Crt;ππProcedure Wait(N : Word); {Very Crude wait routine}πVarπ counter : Word;πbeginπ For Counter:= 1 to N do;πend;ππType Ra = Array[0..0] of Byte;ππVarπ I2 : ^Ra;π spd : Integer;π res : Word;π siz : LongInt;π B : Word;π s : String;π f1 : File of Byte;π F : File;ππbeginπ Write('Enter Voc Filename: ');π readln(S);π {Get Size of File}π Assign(f1,s);π Reset(f1);π spd:=30; {this is the play speed}π siz := FileSize(f1);π close(f1);π {Load up Voc File}π Assign(f,s);π Reset(f);π getmem(I2,siz); {Allocate Memory For VOC File}π BlockRead(f,I2^,siz,res); {Load VOC into Memory)π Writeln('FileSize = ',siz); {Testing Point, not needed}ππ Repeat {This is the actual Play routine} beginπ For b:=0 to siz doπ beginπ Wait(spd); {Wait a bit}π Port[$0378]:=I2^[b]; {Put Byte to DAC}π end;π end Until KeyPressed;ππend.ππ 13 05-28-9313:57ALL SWAG SUPPORT TEAM VOCINFO.PAS IMPORT 19 ■"¿ {π I posted beFore about sample converting... the .VOC to the sampleπ Format used by MODS. You gave me some example code, but the prob is,π VOC Files have a header, how would I do it so that the header wasn'tπ converted?ππHere is the VOC File Format that was posted here a While back. It worksπwell For me.πππA .VOC File consists of a 26-Byte header Record plus sample data.πThe header Record has the following layout:π}πVoiceHeader : Recordπ signature : Array[1..20] of Char; { Vendor's name }π DataStart : Word; { Start of data in File }π Version : Integer; { BCD value: min. driver version required }π ID : Integer; { 1-Complement of Version field+$1234 }π end; { used to indentify a .VOC File }ππThe data is divided into 'blocks'. There are 8 Types of blocks:ππ- 0 : Terminatorπ 1 Byte Record, value 00ππ- 1 : Voice Dataπ 1 Byte, value 01: identifierπ 3 Bytes: length of voice data (len data + 2)π 1 Byte: SR= 256-(1,000,000 / sampling rate)π 1 Byte: pack field, value:π 0 : unpacked, 1 : 4-bit, 2 : 2.6 bit, 3 : 2 bit packedπ <follows voice data>ππ- 2 : Voice Continuationπ 1 Byte, value 02: identifierπ 3 Bytes: length of voice dataπ <follows voice data>ππ- 3 : Silenceπ 1 Byte, value 03: identifierπ 3 Bytes: length of silence period (value 3?)π 2 Bytes: silence period in Units of sampling cyclesπ 1 Byte: SR (see above)ππ- 4 : Markerπ 1 Byte, value 04: identifierπ 3 Bytes: length of marker, value 2π 2 Bytes: user defined markerππ- 5 : ASCII Textπ 1 Byte, value 05: identifierπ 3 Bytes, length of String (not counting null Byte)π <String>π 1 Byte, value 0: String terminatorππ- 6 : Repeat Loopπ 1 Byte, value 06: identifierπ 3 Bytes: length of block, value 2π 2 Bytes: count value+1ππ- 7 : end Repeat Loopπ 1 Byte, value 07: identifierπ 3 Bytes: length of block, value 0ππ{πto my knowledge, the .VOC File Format is proprietary and the dataπherein is only of value For the specific SoundBlaster hardware. I thinkπyou'll have a hard time converting samples to another synthesizer.π}π 14 05-28-9313:57ALL SWAG SUPPORT TEAM VOCPLAY.PAS IMPORT 37 ■"4S {π> Does anybody know where to get some good source that plays Vocs?π}ππ{$A+,B-,D+,E-,F+,G-,I-,L-,N-,O+,R-,S-,V-,X-}π{$M 1024,0,0 }πUnit VOCPlay;ππInterfaceππUsesπ Dos;ππVarπ VoiceStatusWord : Word;π VocPaused,VOCDrvInstalled : Boolean;ππProcedure AllocateMem(Var P : Pointer;Size : LongInt);πFunction AllocateMemFunc(Var P : Pointer;Size : LongInt) : Boolean;πFunction ReAllocateMem(Var P : Pointer;NewSize : LongInt) : Boolean;πProcedure DisAllocateMem(Var P : Pointer);ππProcedure VocOutPut(AdrtoPlay : Pointer);πProcedure VocStop;πProcedure VocPause;πProcedure VocContinue;πProcedure VocSetSpeaker(Onoff : Boolean);πFunction VocInitDriver : Byte;πFunction LoadVoctoMem(DateiName : String;Var VocMem : Pointer) : Boolean;ππImplementationπConstπ VocDriverHeader = 12;π VocFileHeaderLen = $1A;πVarπ PtrtoDriver,OldExitProc : Pointer;π Regs : Registers;π SizeIntern : Word;ππProcedure AllocateMem;πbeginπ Inc(Size,15);π SizeIntern := (Size SHR 4);π Regs.AH := $48;π Regs.BX := SizeIntern;π MsDos(Regs);π if Regs.Flags and FCarry <> 0 thenπ P := NILπ elseπ P := Ptr(Regs.AX,0);πend;ππFunction AllocateMemFunc;πbeginπ AllocateMem(P,Size);π AllocateMemFunc := P <> NIL;πend;ππFunction ReAllocateMem;πbeginπ Inc(NewSize,15);π SizeIntern := (NewSize SHR 4);π Regs.AH := $4A;π Regs.BX := SizeIntern;π Regs.ES := Seg(P^);π MsDos(Regs);π ReAllocateMem := (Regs.BX=SizeIntern);πend;ππProcedure DisAllocateMem;πbeginπ Regs.AH := $49;π Regs.ES := Seg(P^);π MsDos(Regs);πend;ππFunction Exists(FileName : String) : Boolean;πVarπ S : SearchRec;πbeginπ FindFirst(FileName,AnyFile,S);π Exists := (DosError=0);πend;ππFunction VocInitDriver;πConstπ DriverName = 'CT-VOICE.DRV';πTypeπ DriverType = Array [0..VocDriverHeader] of Char;πVarπ Out,S,O : Word;π F : File;πbeginπ Out := 0;π if not Exists(DriverName) thenπ beginπ VocInitDriver := 4;π Exit;π end;π Assign(F,DriverName);π Reset(F,1);π if not AllocateMemFunc(PtrtoDriver,FileSize(F)) then Out := 5;π if Out=0 then BlockRead(F,PtrtoDriver^,FileSize(F));π Close(F);π if Out<>0 thenπ beginπ VocInitDriver := Out;π Exit;π end;π if (DriverType(PtrtoDriver^)[3]<>'C') orπ (DriverType(PtrtoDriver^)[4]<>'T') thenπ beginπ VocInitDriver := 4;π Exit;π end;π S := Seg(VoiceStatusWord);π O := ofs(VoiceStatusWord);π Asmπ mov bx,3π call PtrtoDriverπ mov Out,axπ mov bx,5π mov es,Sπ mov di,Oπ call PtrtoDriverπ end;π VocInitDriver := Out;πend;ππProcedure VocUninstallDriver;πbeginπ if VocDrvInstalled thenπ Asmπ mov bx,9π call PtrtoDriverπ end;πend;ππProcedure VocOutPut;πVarπ S,O : Word;πbeginπ VocSetSpeaker(True);π S := Seg(AdrtoPlay^);π O := ofs(AdrtoPlay^)+VocFileHeaderLen;π Asmπ mov bx,6π mov es,Sπ mov di,Oπ call PtrtoDriverπ end;πend;ππProcedure VocStop;πbeginπ Asmπ mov bx,8π call PtrtoDriverπ end;πend;ππProcedure VocPause;πbeginπ Asmπ mov bx,10π call PtrtoDriverπ end;πend;ππProcedure VocContinue;πbeginπ Asmπ mov bx,11π call PtrtoDriverπ end;πend;ππProcedure VocSetSpeaker;πVar B : Byte;πbeginπ B := ord(Onoff) and $01;π Asmπ mov bx,4π mov al,Bπ call PtrtoDriverπ end;πend;ππFunction LoadVoctoMem;πVar F : File;π Out : Boolean;π Gelesen,Segs : Word;πbeginπ Out := Exists(DateiName);π if Out thenπ beginπ Assign(F,DateiName);Reset(F,1);π if not AllocateMemFunc(VocMem,FileSize(F)) thenπ beginπ Close(F);π LoadVoctoMem := False;π Exit;π end;π Segs := 0;π Repeatπ BlockRead(F,Ptr(Seg(VocMem^)+4096*Segs,ofs(VocMem^))^,$FFFF,Gelesen);π Inc(Segs);π Until Gelesen=0;π Close(F);π end;π LoadVoctoMem := Out;πend;ππ{$F+}πProcedure VocPlayExitProc;πbeginπ VocUninstallDriver;π ExitProc := OldExitProc;πend;π{$F-}ππbeginπ OldExitProc := ExitProc;π ExitProc := @VocPlayExitProc;π VoiceStatusWord := 0;π VocPaused := False;π VocDrvInstalled := (VocInitDriver=0);πend.πππ{$A+,B-,D+,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}π{$M 1024,0,0 }πUses Crt,VOCPlay;πVar VocMem : Pointer;π FileName : String;π Ok : Boolean;πbeginπ FileName := ParamStr(1);π Ok := False;π if VocDrvInstalled then Ok := LoadVoctoMem(DateiName,VocMem);π if Ok thenπ beginπ Write('Playing VOC-File ...');π VocOutPut(VocMem);π Repeatπ Until (VoiceStatusWord=0) or KeyPressed;π Writeln;π DisAllocateMem(VocMem);π endπ else Writeln('Hey, there was something wrong.');πend.π 15 05-28-9313:57ALL SWAG SUPPORT TEAM WHISTLE.PAS IMPORT 5 ■"H { BILL BUCHANAN }ππUsesπ Crt;ππProcedure OpenWhistle;πVarπ Frequency : Integer;πbeginπ For Frequency := 500 to 1000 doπ beginπ Delay(1);π Sound(Frequency)π end;π NoSoundπend;ππProcedure CloseWhistle;πVarπ Frequency: Integer;πbeginπ For Frequency := 1000 downto 500 doπ beginπ Delay(1);π Sound(Frequency)π end;π NoSoundπend;ππbeginπ OpenWhistle;π Readln;π CloseWhistle;πend. 16 05-28-9313:57ALL SWAG SUPPORT TEAM WINSOUND.PAS IMPORT 9 ■"oô {πFellow Windows voyeurs,ππA While ago people were asking how to obtain Sound throughπthe PC speaker without using the multimedia DLL (or aπspeaker driver For that matter.) Below is a basic exampleπof how to do this.π}π Procedure SoundStart;π Varπ Pitch : Integer;π beginπ OpenSound;π For Pitch:= 80 to 84 doπ beginπ SetVoicenote (1, Pitch, 100, 1);π SetVoiceAccent (1, 15, 255, s_Legato, Pitch);π end;π StartSound;π WaitSoundState (S_QueueEmpty);π StopSound;π CloseSoundπ end;ππ{πPlease reference your Windows API reference manual Forπthe SetVoicenote() and SetVoiceAccent() synopsys.ππMicrosoft supports the calls in Windows 3.0, howeverπdocumentation in 3.1 suggests that it will no longerπsupport them. My interpretation is that For theπfuture these calls will be supported, however will notπbe enhanced or Extended. Their reasoning is probablyπbased on there drive to sell their multimedia kits.π}π 17 06-08-9308:16ALL SWAG SUPPORT TEAM Play SOUNDS in BackgroundIMPORT 106 ■"é∩ { SEE XX34 modules at end of document !!!}ππ{$R-,F+}ππ{π ******************************************************************π BGSND.PASππ Background Sound for Turbo Pascalππ Adapted from BGSND.INC for Turbo Pascal 3.0π by Michael Quinlanπ 9/17/85ππ This version for Turbo Pascal 6.0π by Larry Hadleyπ 3/20/93ππ The routines are rather primitive, but could easily be extended.ππ The sample routines included implement something similar to theπ BASIC PLAY statement.π ******************************************************************π}πUnit BGSND;ππINTERFACEππUsesπ DOS;ππCONSTπ BGSVer = '2.0'; { Unit version number }ππ BGSPlaying :boolean = FALSE; { TRUE while music is playing }ππVARπ _BGSNumItems :integer;ππprocedure BGSPlay(n :integer; VAR items);ππprocedure _BGSStopPlay;ππprocedure PlayMusic(s :string);ππIMPLEMENTATIONππTYPEπ BGSItem = RECORDπ cnt :word; { count to load into the 8253-5 timer;π count = 1,193,180 / frequency }π tics:integer; { timer tics to maintain the sound;π 18.2 tics per second }π end;ππ _BGSItemP = ^BGSItem;ππVARπ _BGSNextItem :_BGSItemP;π _BGSOldInt1C :pointer;π _BGSDuration :integer;π ExitSave :pointer;ππprocedure _BGSsaveDS; external; { saves ds as a CS:CONSTANT for useπ within the int 1C vector }πprocedure _BGSPlayNextItem; external; { used by int 1C vector - selects nextπ note to play }πprocedure _BGSStopPlay; external;ππprocedure _BGSInt1C; external; { int1C vector - hooks timer }π{$L BGS.OBJ}ππprocedure BGSPlay(n :integer; VAR items);π{π ***************************************************************************π You call this procedure to play music in the background. You pass theπ number of sound segments, and an array with an element for each soundπ segment. The array elements are two words each; the first word has theπ count to be loaded into the timer (1,193,180 / frequency). The second wordπ has the duration of the sound segment, in timer tics (18.2 tics per second).π ***************************************************************************π}π VARπ item_list : array[0..1000] of BGSItem ABSOLUTE items;π BEGINπ while BGSPlaying do { wait for previous sounds to finish } ;ππ if n > 0 thenπ BEGINπ _BGSNumItems := n;π _BGSNextItem := Addr(item_list[0]);π BGSPlaying := TRUE;π _BGSPlayNextItem;π _BGSsaveDS;π SetIntVec($1C, @_BGSInt1C);π END;π END;ππprocedure BGSErrorExit;π{π **************************************************************************π In case there's an "oopsie" ... make sure that Int $1C is clean, andπ music isn't playing.π **************************************************************************π}π BEGINπ ExitProc := ExitSave;π if BGSPLaying thenπ BEGINπ _BGSStopPlay;π SetIntVec($1C, _BGSOldInt1C);π END;π END;ππ{π **************************************************************************ππ BASIC PLAY Routinesππ **************************************************************************π}ππ{$R+}ππVARπ MusicArea : array[1..255] of BGSItem; { contains sound segments }ππ{π frequency table from:π Peter Norton's Programmer's Guide to the IBM PC, p. 147π}πCONSTπ Frequency : array[0..83] of real =π{ C C# D D# E F F# G G# A A# B }π (32.70, 34.65, 36.71, 38.89, 41.20, 43.65, 46.25, 49.00, 51.91, 55.00, 58.27, 61.74,π 65.41, 69.30, 73.42, 77.78, 82.41, 87.31, 92.50, 98.00, 103.83, 110.00, 116.54, 123.47,π 130.81, 138.59, 146.83, 155.56, 164.81, 174.61, 185.00, 196.00, 207.65, 220.00, 233.08, 246.94,π 261.63, 277.18, 293.66, 311.13, 329.63, 349.23, 369.99, 392.00, 415.30, 440.00, 466.16, 493.88,π 523.25, 554.37, 587.33, 622.25, 659.26, 698.46, 739.99, 783.99, 830.61, 880.00, 932.33, 987.77,π 1046.50, 1108.73, 1174.66, 1244.51, 1378.51, 1396.91, 1479.98, 1567.98, 1661.22, 1760.00, 1864.66, 1975.53,π 2093.00, 2217.46, 2349.32, 2489.02, 2637.02, 2793.83, 2959.96, 3135.96, 3322.44, 3520.00, 3729.31, 3951.07π );ππprocedure PlayMusic(s :string);π{π ***************************************************************************π Accept a string similar to the BASIC PLAY statement. The following areππ allowed:π A to G with optional #ππ Plays the indicated note in the current octave.π A # following the letter indicates sharp.π A number following the letter indicates the length of the noteπ (4 = quarter note, 16 = sixteenth note, 1 = whole note, etc.).ππ Onππ Sets the octave to "n". There are 7 octaves, numbered 0 to 6. Eachπ octave goes from C to B. Octave 3 starts with middle C.ππ Lnππ Sets the default length of following notes. L1 = whole notes, L2 = halfπ notes, etc. The length can be overridden for a specific note by follow-π ing the note letter with a number.ππ Pnππ Pause. n specifies the length of the pause, just like a note.ππ Tnππ Tempo. Number of quarter notes per minute. Default is 120.ππ Period (.) terminates processing.ππ Spaces are allowed between items, but not within items.π ***************************************************************************π}ππ VARπ i, n, { i is the offset in the parameter string;π n is the element number in MusicArea }π NoteLength,π Tempo,π CurrentOctave :integer;π cchar :char;ππ function GetNumber:integer;π {π **************************************************************************π get a number from the parameter stringπ increments i past the end of the numberπ **************************************************************************π }π VARπ n :integer;π BEGINπ n := 0;π WHILE (i <= length(s)) and (s[i] in ['0'..'9']) doπ BEGINπ n := n*10+(Ord(s[i])-Ord('0'));π i := i+1;π end;π GetNumber := n;π END;ππ procedure GetNote;π {π **************************************************************************π Input is a note letter. convert it to two sound segments -- one for theπ sound then a pause following the sound.π increments i past the current itemπ **************************************************************************π }π VARπ note,π len :integer;π l :real;ππ function CheckSharp(n :integer):integer;π {π ************************************************************************π check for a sharp following the letter. increments i if one foundπ ************************************************************************π }π BEGINπ if (i < length(s)) and (s[i] = '#') thenπ BEGINπ i := i + 1;π CheckSharp := n + 1π ENDπ ELSEπ CheckSharp := n;π END; { CheckSharp }ππ function FreqToCount(f : real) : integer;π {π ***********************************************************************π convert a frequency to a timer countπ ***********************************************************************π }π BEGINπ FreqToCount := Round(1193180.0/f);π END; { FreqToCount }ππ BEGIN { GetNote }π case cchar ofπ 'A' : note := CheckSharp(9);π 'B' : note := 11;π 'C' : note := CheckSharp(0);π 'D' : note := CheckSharp(2);π 'E' : note := 4;π 'F' : note := CheckSharp(5);π 'G' : note := CheckSharp(7)π end; { case }ππ MusicArea[n].cnt := FreqToCount(Frequency[(CurrentOctave*12)+note]);π if (s[i] in ['0'..'9']) and (i <= length(s)) thenπ len := GetNumberπ elseπ len := NoteLength;π l := 18.2*60.0*4.0/(Tempo*len);π MusicArea[n].tics := Round(7.0*l/8.0);ππ if MusicArea[n].tics = 0 thenπ MusicArea[n].tics := 1;π n := n + 1;π MusicArea[n].cnt := 0;π MusicArea[n].tics := Round(l/8.0);ππ if MusicArea[n].tics = 0 thenπ MusicArea[n].tics := 1;π n := n + 1;π END; { GetNote }ππ procedure GetPause;π {π ************************************************************************π input is a pause. convert it to a silent sound segment.π increments i past the current itemπ ************************************************************************π }π VARπ len :integer;π l :real;ππ BEGIN { GetPause }π MusicArea[n].cnt := 0;π if (s[i] in ['0'..'9']) and (i <= length(s)) thenπ len := GetNumberπ elseπ len := NoteLength;π l := 18.2*60.0*4.0/(Tempo*len);π MusicArea[n].tics := Round(l);π if MusicArea[n].tics = 0 thenπ MusicArea[n].tics := 1;π n := n + 1;π END; { GetPause }ππ BEGIN { PlayMusic }π NoteLength := 4;π Tempo := 120;π CurrentOctave := 3;ππ n := 1;π i := 1;π while (i <= length(s)) and (s[i]<>'.') doπ BEGINπ cchar := s[i];π i := i + 1;π case cchar ofπ 'A'..'G' : GetNote;π 'O' : CurrentOctave := GetNumber;π 'L' : NoteLength := GetNumber;π 'P' : GetPause;π 'T' : Tempo := Getnumberπ end; { case }π END;π BGSPlay(n-1, MusicArea)π END; { PlayMusic }ππBEGIN { Unit init code }π ExitSave := ExitProc;π ExitProc := @BGSErrorExit;ππ GetIntVec($1C, _BGSOldInt1C);ππ Writeln('BGS v'+BGSVer);πEND.ππ(* DEMO PROGRAM FOR BACKGROUND SOUND *)ππ{$M 1024, 0, 0}πProgram PlayBG;ππUsesπ DOS,π CRT,π BGSND;ππVARπ F1 :text;π play_str, buf,π fname, progname :string;ππProcedure Usage;π BEGINπ Writeln('PLAYBG <playfile>');π Writeln(#10+#13+'Where:');π Writeln(' <playfile> is the file containing the music you want played in');π Writeln(' the background');π Writeln(#10+#13+'The playfile contains a series of notes in ascii format');π Writeln;π Halt(1);π END;ππ{$I-}πFunction Exists(name:string):boolean;π VARπ F :file;π BEGINπ Assign(f, name);π Reset(f);π if IOresult<>0 thenπ Exists := FALSEπ ELSEπ BEGINπ Exists := TRUE;π Close(f);π END;π END;π{$I+}ππFunction AskYN:boolean;π VARπ ch :char;π BEGINπ repeatπ ch := ReadKey;π if ch = #0 thenπ BEGINπ ch := ReadKey;π ch := #0;π END;π until ch in ['y','Y','n','N'];π Write(ch);π case ch ofπ 'Y','y' : AskYN := TRUE;π 'N','n' : AskYN := FALSE;π END;π END;ππBEGINπ Writeln('Background Play 1.0');ππ if ParamCount<1 thenπ Usage;ππ fname := ParamStr(1);π Assign(F1, fname);ππ if (fname='') or not(Exists(fname)) thenπ BEGINπ Writeln('Invalid playfile.');π Halt(2);π END;ππ play_str := '';π Reset(F1);ππ repeatπ ReadLn(F1, buf);π play_str := play_str+buf;π until Eof(F1) or (Length(play_str)>=200);ππ Close(F1);ππ Writeln(play_str); {debug}π PlayMusic(play_str);ππ Exec(GetEnv('COMSPEC'), '');ππ if BGSPlaying thenπ BEGINπ Writeln('Music still playing - wait for it to finish?');π if Not(AskYN) thenπ _BGSStopPlay;π while BGSPLaying do;π END;πEND.ππ(*ππXX34 Of OBJ CODE FILES. Extract to separte files and use XX3401 toπcreate BGS.OBJ and PLAYFIL.ASC. Here is how to use :ππ1. Copy first block to BGS.XX.π2. run XX3401 : XX3401 D BGS.XX. This will create BGS.OBJ.π3. Copy second block to PLAYFIL.XX.π4. run XX3401 : XX3401 D PLAYFIL.XXπ5. Write unit code to BGSND.PAS. Compile.π6. Write demo code to PLAYSND.PAS Compile and run.ππππ*XX3401-000674-210393--68--85-48874---------BGS.OBJ--1-OF--1πU-U+3aIuL4ZWPJlWNrBjRKtYL47bQmt-IooeW0++++-IRL7WPm--QrBZPK7gNL6U63NZπQbBdPqsUAWskAMS65U-+uF6-RFcKNHdQOK7hL47bQqxpPaFQMaRn9Y3HHJ46+k-+uImKπ+U++O6U1+20VZ7M9++F2EJF--2F-J22Xa+Q+G++++UA-2tM9++F1HoF3-2BDF2IVa+Q+π8Bo+-+I-Icl3++lTEYRHHZJBGJF3HJA+13x0FpBCFJVIGJF3HE+ALo75IoxAF2ZCJ131π++lTEYRHF3JGEJF7Hos+0Y75Ip-AEJZ7HYQ+ZN+L+++023x0FpBEH23NHYJMJ2ZIFIp3π+++XY-++++67Lo75IoZCJ131WE++Ad+F+++00Zx0FpBHFJF7HZE6+++tY-A+++6ALo75πIpBIHp-EH23N8E++Pt+F+++00Zx0FpBHEJN3F3A0++-EW+E+E86-YO1T++60+0uA5U++πmpK9v9U++6v+WoM8gEHqsMjsWoM4yei9FUWfysjZLQc4+9UQ+30V+U-EcE++I+vcnzzYπMGHsta54-U+++AhJWymV++-6ck++g9PaEwEy+++aWULaEWO8FE5aEWO9FE8X+++aUno+πR+PYMEk1ta52DU++XII2XA8X++073U6+WyJRmpK9v3-HIJ7KJls4ymuC5U++cE++G8A+π+6Ay++++RGbYMGHsta41DU+++5IMi-k+I820+30V++-E1iV1zwM4++++ukKE1iVozkQTπLptOKJhMWyJRnsmQLU12+pE0l0k4+ED2A+M-+wEz-U23l2Q4+E52GkM-+QFH-U20l4I4π+EH2REM-+gFx-U20l624+E92ZZE0l7Y4+EH2bEM--AGV-U22l8s4+E52i+M-+wGw-U21πlAI4+EJrWU6++5E+π***** END OF XX-BLOCK *****ππ{------------------------- CUT HERE -------------------------------}ππ*XX3401-000047-210393--68--85-51905-----PLAYFIL.ASC--1-OF--1πJ1Uk62wo62ks62R4FIN5FoQUI1UUFYN4B0-5EY6o62R4FIN5FoQUFoN4FoN31Ec+π***** END OF XX-BLOCK *****ππ*)πππ 18 06-08-9308:27ALL MARK LEWIS Raw Speaker Support IMPORT 13 ■"àÜ (*π===========================================================================π BBS: Canada Remote SystemsπDate: 05-31-93 (17:52) Number: 24475πFrom: MARK LEWIS Refer#: NONEπ To: CHARLES LUMIA Recvd: NOπSubj: PC SPEAKER AND RAW SO Conf: (1221) F-PASCALπ---------------------------------------------------------------------------π > Do you know how to send stuff to a PC speaker, I can't even findπ > the port # for it OR how to output any data through it?ππtry this on for size ... these are three TP 6.0 Assembler routines that "mimic"πthe same ones that come in TP's CRT unit. DELAY was given to me by Sean Palmerπ(thanks sean! it works as advertised -=B-) and the other two i hacked outπmyself...ππprocedure delay(ms : word); Assembler;π{ms is the number of milliseconds to delay. 1000ms = 1second}π*)ππasmπ mov ax,1000π mul msπ mov cx,dxπ mov dx,axπ mov ah,$86π int $15πend;ππprocedure sound( hertz : word); Assembler;π{hertz is the sound frequency to send to the speaker port}ππasmπ MOV BX,SPπ MOV BX,&hertzπ MOV AX,34DDhπ MOV DX,0012hπ CMP DX,BXπ JNB @J1π DIV BXπ MOV BX,AXπ IN AL,61hπ TEST AL,03hπ JNZ @J2π OR AL,03hπ OUT 61h,ALπ MOV AL,-4Ahπ OUT 43h,ALπ@J2:π MOV AL,BLπ OUT 42h,ALπ MOV AL,BHπ OUT 42h,ALπ@J1:πend;ππprocedure nosound; Assembler;π{turns the speaker off}πasmπ IN AL,61hπ AND AL,0FChπ OUT 61h,ALπend;ππ 19 06-22-9309:24ALL SWAG SUPPORT TEAM Sonic effects IMPORT 19 ■"ï UNIT Tones;ππ{ TONES - a set of functions that provide someπ interesting sonic effects. Useful for gamesπ or alerts. }ππINTERFACEππPROCEDURE Tone(CycleLen,NbrCycles: Integer);πPROCEDURE Noise(D: Longint);πPROCEDURE Chirp(F1,F2,Cycles: Integer);πPROCEDURE Sound2(F: Longint);πPROCEDURE NoSound2;ππIMPLEMENTATIONππ{ Tone - output a toneππ INP: cyclen - Length (counts) for 1/2 cycleπ numcyc - number of cycles to make }ππPROCEDURE Tone(CycleLen,NbrCycles: Integer);ππVARπ T,I,J : Integer;ππBEGINπ NbrCycles := NbrCycles SHL 1; {# half Cycles}π T := Port[$61]; {Port contents}π FOR I := 1 TO NbrCycles DOπ BEGINπ T := T XOR 2;π Port[$61] := T;π FOR J :=1 TO CycleLen DOπ ENDπEND;πππ{ Noise - make noise for a certain amount ofπ counts.ππ INP: D - the number of kilocounts of Noise}ππPROCEDURE Noise(D: Longint);πVARπ Count : Longint;π T,J,I : Integer;πBEGINπ T := Port[$61];π Count := 0;π WHILE Count < D DOπ BEGINπ J := (Random(32768) MOD 128) SHL 4;π FOR I := 1 TO J DO;π T := T XOR 2;π Port[$61] := T;π Inc(Count,J)π ENDπEND;ππ{ Chirp - create a 'bird Chirp' TYPE Noiseππ INP:F1 - # OF counts FOR the starting freq.π F2 - # OF counts FOR the ending freq.π Cycles - # OF Cycles OF each frequency }ππPROCEDURE Chirp(F1,F2,Cycles: Integer);πVARπ I,J,K,L : Integer;πBEGINπ L := Port[$61];π Cycles := Cycles * 2;π I := F1;π WHILE I <> F2 DOπ BEGINπ FOR J := 1 TO Cycles DOπ BEGINπ L := L XOR 2;π Port[$61] := L;π FOR K := 1 TO I DOπ END;π IF F1 > F2 THEN Dec(I)π ELSE Inc(I)π ENDπEND;ππ{ Sound2 - Generate a continuous tone using theπ internal timer.ππ INP: F - the desired frequeny }ππPROCEDURE Sound2(F: Longint);πVARπ C : Longint;πBEGINπ IF F < 19 THEN F := 19; {Prevent overflow}π C := 1193180 DIV F;π Port[$43] := $B6; {Program new divisor}π Port[$42] := C MOD 256; {Rate into the timer}π Port[$42] := C DIV 256;π C := Port[$61]; {Enable speaker output}π Port[$61] := C OR 3 {from the timer }πEND;πππ{ NoSound2 - turn off the continuous tone }ππPROCEDURE NoSound2;πVARπ C : Integer;πBEGINπ C := Port[$61]; {Mask off speaker}π Port[$61] := C AND $FC {output from timer}πEND;ππEND.π 20 07-16-9306:01ALL MARK SHADARAM Detect Adlib Sound Card IMPORT 16 ■"Qc ===========================================================================π BBS: Canada Remote SystemsπDate: 06-25-93 (17:55) Number: 27742πFrom: T.C. DOYLE Refer#: NONEπ To: ALL Recvd: NO πSubj: Pascal Code How To Detect Conf: (1221) F-PASCALπ---------------------------------------------------------------------------π I found this in the shareware echo...hmm...wrong place:)π So I decided to forward this message here:ππππ * Originally By: Mark Shadaramπ * Originally To: Allπ * Originally Re: Pascal Code How To Detect Adlib Sound Cardπ * Original Area: <FIDO> Shareware Forumπ * Forwarded by : Blue Wave v2.12ππ{ How to Detect Adlib Sound Card}π{ Coded By Mark Shadaram ( mark.shadaram@oubbs.telecom.uoknor.edu)}πProcedure SetAdlib(Address, Data:Byte); VAR X,I:Byte;πBEGIN Port[$388]:=Address;π for I:= 1 to 6 do X:=Port[$388]; {Delay}π Port[$389]:=Data;π for I:= 1 to 35 do X:=Port[$388]; {Delay}πEND;πFunction DetectAdlib:Boolean; VAR X,X2:Byte;πBEGIN SetAdlib($4,$60); {Step 1}π SetAdlib($4,$80); {Step 2}π Delay(10);{Just to make sure!}π X:=Port[$388]; {Step 3}π SetAdlib($2,$ff); {Step 4}π SetAdlib($4,$21); {Step 5}π Delay(10);{Just to make sure!} {Step 6}π X2:=Port[$388]; {Step 7}π SetAdlib($4,$60); {Step 8}π SetAdlib($4,$80);π X:= X AND $E0; {Step 9}π X2:= X2 AND $E0;π IF (X =$0) AND (X2 =$C0) THENπ DetectAdlib:=TRUE ELSE DetectAdlib:=FALSE;πEND;ππ-!- Tag 2.6e + FMail 0.94π ! Origin: NightShift / Wichita Falls, TX (817)855-1526 (1:3805/13)ππ--- GEcho/Telegardπ * Origin: Never mind the bollocks here's TEROX BBS (1:120/324.0)π 21 07-16-9306:29ALL SWAG SUPPORT TEAM Play CMF Files on SB IMPORT 103 ■"DG UNIT CMFTool;π{** Unit - uses SBFMDRV.COM **}πINTERFACEπUSES Dos;πTYPEπ CMFFileTyp = FILE;π CMFDataTyp = Pointer;π CMFHeader = RECORDπ CMFFileID : ARRAY[0..3] OF CHAR;π CMFVersion : WORD;π CMFInstrBlockOfs : WORD;π CMFMusicBlockOfs : WORD;π CMFTickPerBeat : WORD;π CMFClockTicksPS : WORD;π CMFFileTitleOfs : WORD;π CMFComposerOfs : WORD;π CMFMusicRemarkOfs : WORD;π CMFChannelsUsed : ARRAY[0..15] OF CHAR;π CMFInstrNumber : WORD;π CMFBasicTempo : WORD;π END;πCONSTπ CMFToolVersion = 'v1.0';πVARπ CMFStatusByte : BYTE;π CMFErrStat : WORD;π CMFDriverInstalled : BOOLEAN;π CMFDriverIRQ : WORD;π CMFSongPaused : BOOLEAN;π OldExitProc : Pointer;πPROCEDURE PrintCMFErrMessage;πFUNCTION CMFGetSongBuffer(VAR CMFBuffer : Pointer; CMFFile : STRING):BOOLEAN;πFUNCTION CMFFreeSongBuffer (VAR CMFBuffer : Pointer):BOOLEAN;πFUNCTION CMFInitDriver : BOOLEAN;πFUNCTION CMFGetVersion : WORD;πPROCEDURE CMFSetStatusByte;πFUNCTION CMFSetInstruments(VAR CMFBuffer : Pointer):BOOLEAN;πFUNCTION CMFSetSingleInstruments(VAR CMFInstrument:Pointer; No:WORD):BOOLEAN;πPROCEDURE CMFSetSysClock(Frequency : WORD);πPROCEDURE CMFSetDriverClock(Frequency : WORD);πPROCEDURE CMFSetTransposeOfs (Offset : INTEGER);πFUNCTION CMFPlaySong(VAR CMFBuffer : Pointer) : BOOLEAN;πFUNCTION CMFStopSong : BOOLEAN;πFUNCTION CMFResetDriver:BOOLEAN;πFUNCTION CMFPauseSong : BOOLEAN;πFUNCTION CMFContinueSong : BOOLEAN;πIMPLEMENTATIONπTYPEπ TypeCastTyp = ARRAY [0..6000] of Char;πVARπ Regs : Registers;π CMFIntern : ^CMFHeader; { Internal pointer to CMF structure }πPROCEDURE PrintCMFErrMessage;π{ PURPOSE : Displays SB error as text; no change to error status. }πBEGINπ CASE CMFErrStat OFπ 100 : Write(' SBFMDRV sound driver not found ');π 110 : Write(' Driver reset successful ');π 200 : Write(' CMF file not found ');π 210 : Write(' No memory free for CMF file ');π 220 : Write(' File not in CMF format ');π 300 : Write(' Memory allocation error occurred ');π 400 : Write(' Too many instruments defined ');π 500 : Write(' CMF data could not be played ');π 510 : Write(' CMF data could not be stopped ');π 520 : Write(' CMF data could not be paused ');π 530 : Write(' CMF data could not be continued ');π END;π END;πFUNCTION Exists (Filename : STRING):BOOLEAN;π{ PURPOSE : Checks for the existence of a file, and returns a Boolean exp. }πVARπ F : File;πBEGINπ Assign(F,Filename);π{$I-}π Reset(F);π Close(F);π{$I+}π Exists := (IoResult = 0) AND (Filename <> '');π END;πPROCEDURE AllocateMem (VAR Pt : Pointer; Size : LongInt);π{ Reserves as many bytes as Size allows, then sets the pointer in theπ Pt variable. If not enough memory is available, Pt is set to NIL. }πVARπ SizeIntern : WORD;πBEGINπ Inc(Size,15);π SizeIntern := (Size shr 4);π Regs.AH := $48;π Regs.BX := SizeIntern;π MsDos(Regs);π IF (Regs.BX <> SizeIntern) THEN Pt := NILπ ELSE Pt := Ptr(Regs.AX,0);π END;πFUNCTION CheckFreeMem (VAR CMFBuffer : Pointer; CMFSize : LongInt):BOOLEAN;π{ Ensures that enough memory has been allocated for CMF file. }πBEGINπ AllocateMem(CMFBuffer,CMFSize);π CheckFreeMem := CMFBuffer <> NIL;π END;πFUNCTION CMFGetSongBuffer(VAR CMFBuffer : Pointer; CMFFile : STRING):BOOLEAN;π{ Loads file into memory; returns TRUE if load successful, FALSE if not. }πCONSTπ FileCheck : STRING[4] = 'CTMF';πVARπ CMFFileSize : LongInt;π FPresent : BOOLEAN;π VFile : CMFFileTyp;π Segs : WORD;π Read : WORD;π Checkcount : BYTE;πBEGINπ FPresent := Exists(CMFFile);ππ{ CMF file could not be found }π IF Not(FPresent) THEN BEGINπ CMFGetSongBuffer := FALSE;π CMFErrStat := 200;π EXITπ END;π Assign(VFile,CMFFile);π Reset(VFile,1);π CMFFileSize := Filesize(VFile);π AllocateMem(CMFBuffer,CMFFileSize);π{ Insufficient memory for CMF file }π IF (CMFBuffer = NIL) THEN BEGINπ Close(VFile);π CMFGetSongBuffer := FALSE;π CMFErrStat := 210;π EXIT;π END;π Segs := 0;π REPEATπ Blockread(VFile,Ptr(seg(CMFBuffer^)+4096*Segs,Ofs(CMFBuffer^))^,$FFFF,Readπ);π Inc(Segs);π UNTIL Read = 0;π Close(VFile);π{ File not in CMF format }π CMFIntern := CMFBuffer;π CheckCount := 1;π REPEATπ IF FileCheck[CheckCount] = CMFIntern^.CMFFileID[CheckCount-1]π THEN Inc(CheckCount)π ELSE CheckCount := $FF;π UNTIL CheckCount >= 3;π IF NOT(CheckCount = 3) THEN BEGINπ CMFGetSongBuffer := FALSE;π CMFErrStat := 220;π EXIT;π END;π{ Load was successful }π CMFGetSongBuffer := TRUE;π CMFErrStat := 0;π END;πFUNCTION CMFFreeSongBuffer (VAR CMFBuffer : Pointer):BOOLEAN;π{ Frees memory allocated for CMF file. }πBEGINπ Regs.AH := $49;π Regs.ES := seg(CMFBuffer^);π MsDos(Regs);π CMFFreeSongBuffer := TRUE;π IF (Regs.AX = 7) OR (Regs.AX = 9) THEN BEGINπ CMFFreeSongBuffer := FALSE;π CMFErrStat := 300π END;π END;πFUNCTION CMFInitDriver : BOOLEAN;π{ Checks for SBFMDRV.COM resident in memory, and resets driver }πCONSTπ DriverCheck :STRING[5] = 'FMDRV';πVARπ ScanIRQ,π CheckCount : BYTE;π IRQPtr,π DummyPtr : Pointer;ππBEGINπ{ Possible SBFMDRV interrupts lie in range $80 - $BF }π FOR ScanIRQ := $80 TO $BF DO BEGINπ GetIntVec(ScanIRQ, IRQPtr);π DummyPtr := Ptr(Seg(IRQPtr^), $102);π{ Check for string 'FMDRV' in interrupt program. }π CheckCount := 1;π REPEATπ IF DriverCheck[CheckCount] = TypeCastTyp(DummyPtr^)[CheckCount]π THEN Inc(CheckCount)π ELSE CheckCount := $FF;π UNTIL CheckCount >= 5;π IF (CheckCount = 5) THEN BEGINπ{ String found; reset executed }π Regs.BX := 08;π CMFDriverIRQ := ScanIRQ;π Intr(CMFDriverIRQ, Regs);π IF Regs.AX = 0 THENπ CMFInitDriver := TRUEπ ELSE BEGINπ CMFInitDriver := FALSE;π CMFErrStat := 110;π END;π Exit;π ENDπ ELSE BEGINπ{ String not found }π CMFInitDriver := FALSE;π CMFErrStat := 100;π END;π END;π END;πFUNCTION CMFGetVersion : WORD;π{ Gets version number from SBFMDRV driver. }πBEGINπ Regs.BX := 0;π Intr(CMFDriverIRQ,Regs);π CMFGetVersion := Regs.AX;π END;πPROCEDURE CMFSetStatusByte;π{ Place driver status byte in CMFStatusByte variable. }πBEGINπ Regs.BX:= 1;π Regs.DX:= Seg(CMFStatusByte);π Regs.AX:= Ofs(CMFStatusByte);π Intr(CMFDriverIRQ, Regs);π END;πFUNCTION CMFSetInstruments(VAR CMFBuffer : Pointer):BOOLEAN;π{ Sets SB card FM registers to instrumentation stated in CMF file. }πBEGINπ CMFIntern := CMFBuffer;π IF CMFIntern^.CMFInstrNumber > 128 THEN BEGINπ CMFErrStat := 400;π CMFSetInstruments := FALSE;π Exit;π END;π Regs.BX := 02;π Regs.CX := CMFIntern^.CMFInstrNumber;π Regs.DX := Seg(CMFBuffer^);π Regs.AX := Ofs(CMFBuffer^)+CMFIntern^.CMFInstrBlockOfs;π Intr(CMFDriverIRQ, Regs);π CMFSetInstruments := TRUE;π END;πFUNCTION CMFSetSingleInstruments(VAR CMFInstrument:Pointer; No:WORD):BOOLEAN;π{ Sets SB FM registers to instrument values corresponding to theπ data structure following the CMFInstrument pointer. }πBEGINπ IF No > 128 THEN BEGINπ CMFErrStat := 400;π CMFSetSingleInstruments := FALSE;π Exit;π END;π Regs.BX := 02;π Regs.CX := No;π Regs.DX := Seg(CMFInstrument^);π Regs.AX := Ofs(CMFInstrument^);π Intr(CMFDriverIRQ, Regs);π CMFSetSingleInstruments := TRUE;π END;πPROCEDURE CMFSetSysClock(Frequency : WORD);π{ Sets default value of timer 0 to new value. }πBEGINπ Regs.BX := 03;π Regs.AX := (1193180 DIV Frequency);π Intr(CMFDriverIRQ, Regs);π END;πPROCEDURE CMFSetDriverClock(Frequency : WORD);π{ Sets driver timer frequency to new value. }ππBEGINπ Regs.BX := 04;π Regs.AX := (1193180 DIV Frequency);π Intr(CMFDriverIRQ, Regs);π END;πPROCEDURE CMFSetTransposeOfs (Offset : INTEGER);π{ Transposes all notes in the CMF file by "Offset." }πBEGINπ Regs.BX := 05;π Regs.AX := Offset;π Intr(CMFDriverIRQ, Regs);π END;πFUNCTION CMFPlaySong(VAR CMFBuffer : Pointer) : BOOLEAN;π{ Initializes all important parameters and starts song playback. }πVARπ Check : BOOLEAN;πBEGINπ CMFIntern := CMFBuffer;π{ Set driver clock frequency }π CMFSetDriverClock(CMFIntern^.CMFClockTicksPS);π{ Set instruments }π Check := CMFSetInstruments(CMFBuffer);π IF Not(Check) THEN Exit;π Regs.BX := 06;π Regs.DX := Seg(CMFIntern^);π Regs.AX := Ofs(CMFIntern^)+CMFIntern^.CMFMusicBlockOfs;π Intr(CMFDriverIRQ, Regs);π IF Regs.AX = 0 THEN BEGINπ CMFPlaySong := TRUE;π CMFSongPaused := FALSE;π ENDπ ELSE BEGINπ CMFPlaySong := FALSE;π CMFErrStat := 500;π END;π END;πFUNCTION CMFStopSong : BOOLEAN;π{ Attempts to stop song playback. }πBEGINπ Regs.BX := 07;π Intr(CMFDriverIRQ, Regs);π IF Regs.AX = 0 THENπ CMFStopSong := TRUEπ ELSE BEGINπ CMFStopSong := FALSE;π CMFErrStat := 510;π END;π END;πFUNCTION CMFResetDriver:BOOLEAN;π{ Resets driver to starting status. }πBEGINπ Regs.BX := 08;π Intr(CMFDriverIRQ, Regs);π IF Regs.AX = 0 THENπ CMFResetDriver := TRUEπ ELSE BEGINπ CMFResetDriver := FALSE;π CMFErrStat := 110;π END;π END;πFUNCTION CMFPauseSong : BOOLEAN;π{ Attempts to pause song playback. If pause is possible, thisπ function sets the CMFSongPaused variable to TRUE. }πBEGINπ Regs.BX := 09;π Intr(CMFDriverIRQ, Regs);π IF Regs.AX = 0 THEN BEGINπ CMFPauseSong := TRUE;π CMFSongPaused := TRUE;π ENDπ ELSE BEGINπ CMFPauseSong := FALSE;π CMFErrStat := 520;π END;π END;πFUNCTION CMFContinueSong : BOOLEAN;π{ Attempts to continue playback of a paused song. If continuationπ is possible, this function sets CMFSongPaused to FALSE. }πBEGINπ Regs.BX := 10;π Intr(CMFDriverIRQ, Regs);π IF Regs.AX = 0 THEN BEGINπ CMFContinueSong := TRUE;π CMFSongPaused := FALSE;π ENDπ ELSE BEGINπ CMFContinueSong := FALSE;π CMFErrStat := 530;ππ END;π END;π{$F+}πPROCEDURE CMFToolsExitProc;π{$F-}π{ Resets the status byte address, allowing this program to exit.}πBEGINπ Regs.BX:= 1;π Regs.DX:= 0;π Regs.AX:= 0;π Intr(CMFDriverIRQ, Regs);π ExitProc := OldExitProc;π END;πBEGINπ{ Reset old ExitProc to the Tool unit proc }π OldExitProc := ExitProc;π ExitProc := @CMFToolsExitProc;π{ Initialize variables }π CMFErrStat := 0;π CMFSongPaused := FALSE;π{ Initialize driver }π CMFDriverInstalled := CMFInitDriver;π IF CMFDriverInstalled THEN BEGINπ CMFStatusByte := 0;π CMFSetStatusByte;π END;π END.ππ{ --------------------- DEMO PROGRAM ----------------- }ππProgram CMFDemo;π{* Demo program for CMFTOOL unit *}π{$M 16384,0,65535}πUses CMFTool,Crt;πVARπ Check : BOOLEAN;π SongName : String;π SongBuffer : CMFDataTyp;πPROCEDURE TextNumError;π{* INPUT : None; data comes from CMFErrStat global variableπ * OUTPUT : Noneπ * PURPOSE : Displays SB error as text, including error number. }πBEGINπ Write(' Error #',CMFErrStat:3,': ');π PrintCMFErrMessage;π WriteLn;π Halt(CMFErrStat);π END;πBEGINπ ClrScr;π{ Displays error if SBFMDRV driver has not been installed }π IF Not (CMFDriverInstalled) THEN TextNumError;π{ If no song name is included with command line parameters,π program searches for the default name (here STARFM.CMF). }π IF ParamCount = 0 THEN SongName := 'STARFM.CMF'π ELSE SongName := ParamStr(1);π{ Display driver's version and subversion numbers }π GotoXY(28,5);π Write ('SBFMDRV Version ',Hi(CMFGetVersion):2,'.');π WriteLn(Lo(CMFGetVersion):2,' loaded');π{ Display interrupt number in use }π GotoXY(24,10);π Write ('System interrupt (IRQ) ');π WriteLn(CMFDriverIRQ:3,' in use');π GotoXY(35,15);π WriteLn('Song Status');π GotoXY(31,23);π WriteLn('Song name: ',SongName);π{ Load song file }π Check := CMFGetSongBuffer(SongBuffer,SongName);π IF NOT(Check) THEN TextNumError;π{ CMFSetTransposeOfs() controls transposition down or up of the loaded songπ (positive values transpose up, negative values transpose down). The valueπ 0 plays the loaded song in its original key. }π CMFSetTransposeOfs(0); { Experiment with this value }π{ Play song }π Check := CMFPlaySong(SongBuffer);π IF NOT(Check) THEN TextNumError;π{ During playback, display status byte }π REPEATπ GotoXY(41,17);Write(CMFStatusByte:3);π UNTIL (KeyPressed OR (CMFStatusByte = 0));π{ Stop playback if user presses a key }π IF KeyPressed THEN BEGINπ Check := CMFStopSong;π IF NOT(Check) THEN TextNumError;π END;π{ Re-initialize driver }π Check := CMFResetDriver;π IF NOT(Check) THEN TextNumError;π{ Free song file memory }π Check := CMFFreeSongBuffer(SongBuffer);π IF NOT(Check) THEN TextNumError;π END.π 22 07-16-9306:30ALL SWAG SUPPORT TEAM Play VOC files on SB IMPORT 103 ■"╫e UNIT VOCTOOL;π{* Unit - uses CT-VOICE.DRV. *}πINTERFACEπTYPEπ VOCFileTyp = File;πCONSTπ VOCToolVersion = 'v1.5';π VOCBreakEnd = 0;π VOCBreakNow = 1;πVARπ VOCStatusWord : WORD;π VOCErrStat : WORD;π VOCFileHeader : STRING;π VOCFileHeaderLength : BYTE;π VOCPaused : BOOLEAN;π VOCDriverInstalled : BOOLEAN;π VOCDriverVersion : WORD;π VOCPtrToDriver : Pointer;π OldExitProc : Pointer;πPROCEDURE PrintVOCErrMessage;πFUNCTION VOCGetBuffer(VAR VoiceBuff : Pointer; Voicefile : STRING):BOOLEAN;πFUNCTION VOCFreeBuffer(VAR VoiceBuff : Pointer):BOOLEAN;πFUNCTION VOCGetVersion:WORD;πPROCEDURE VOCSetPort(PortNumber : WORD);πPROCEDURE VOCSetIRQ(IRQNumber : WORD);πFUNCTION VOCInitDriver:BOOLEAN;πPROCEDURE VOCDeInstallDriver;πPROCEDURE VOCSetSpeaker(OnOff:BOOLEAN);πPROCEDURE VOCOutput(BufferAddress : Pointer);πPROCEDURE VOCOutputLoop (BufferAddress : Pointer);πPROCEDURE VOCStop;πPROCEDURE VOCPause;πPROCEDURE VOCContinue;πPROCEDURE VOCBreakLoop(BreakMode : WORD);πIMPLEMENTATIONπUSES DOS,Crt;πTYPEπ TypeCastType = ARRAY [0..6000] of Char;πVARπ Regs : Registers;πPROCEDURE PrintVOCErrMessage;π{* INPUT : Noneπ * OUTPUT : Noneπ * PURPOSE : Displays SB error as text; no change to error status. }πBEGINπ CASE VOCErrStat OFπ 100 : Write(' Driver file CT-VOICE.DRV not found ');π 110 : Write(' No memory available for driver file ');π 120 : Write(' False driver file ');π 200 : Write(' VOC file not found ');π 210 : Write(' No memory available for driver file ');π 220 : Write(' File not in VOC format ');π 300 : Write(' Memory allocation error occurred ');π 400 : Write(' No sound blaster card found ');π 410 : Write(' False port address used ');π 420 : Write(' False interrupt used ');π 500 : Write(' No loop in process ');π 510 : Write(' No sample for output ');π 520 : Write(' No sample available ');π END;π END;ππFUNCTION Exists (Filename : STRING):BOOLEAN;π{* INPUT : Filename as stringπ * OUTPUT : TRUE if file is available, FALSE if notπ * PURPOSE : Checks for availability of file then returns Boolean exp. }πVARπ F : File;πBEGINπ Assign(F,Filename);π{$I-}π Reset(F);π Close(F);π{$I+}π Exists := (IoResult = 0) AND (Filename <> '');π END;πPROCEDURE AllocateMem (VAR Pt : Pointer; Size : LongInt);π{* INPUT : Buffer variable as pointer, buffer size as LongIntπ * OUTPUT : Pointer to buffer in variable or NILπ * PURPOSE : Reserves as many bytes as Size allows, then moves pointer inπ the Pt variable. If not enough memory is available, Pt = NIL. }πVARπ SizeIntern : WORD;πBEGINπ Inc(Size,15);π SizeIntern := (Size shr 4);π Regs.AH := $48;π Regs.BX := SizeIntern;π MsDos(Regs);π IF (Regs.BX <> SizeIntern) THEN Pt := NILπ ELSE Pt := Ptr(Regs.AX,0);π END;πFUNCTION CheckFreeMem (VAR VoiceBuff : Pointer; VoiceSize : LongInt):BOOLEAN;π{* INPUT : Buffer variable as pointer, size as LongIntπ * OUTPUT : Pointer to buffer, TRUE/FALSE, after AllocateMemπ * PURPOSE : Checks for sufficient memory to store a VOC file. }πBEGINπ AllocateMem(VoiceBuff,VoiceSize);π CheckFreeMem := VoiceBuff <> NIL;π END;πFUNCTION VOCGetBuffer (VAR VoiceBuff : Pointer; Voicefile : STRING):BOOLEAN;π{* INPUT : Buffer variable as pointer, file name as stringπ * OUTPUT : Pointer to buffer with VOC data, TRUE/FALSEπ * PURPOSE : Loads a file into memory and returns TRUE if file loadedπ successfully, and FALSE if not. }πVARπ SampleSize : LongInt;π FPresent : BOOLEAN;π VFile : VOCFileTyp;π Segs : WORD;π Read : WORD;πBEGINπ FPresent := Exists(VoiceFile);π{ VOC file not found }π IF Not(FPresent) THEN BEGINπ VOCGetBuffer := FALSE;π VOCErrStat := 200;π EXITπ END;π Assign(VFile,Voicefile);π Reset(VFile,1);π SampleSize := Filesize(VFile);π AllocateMem(VoiceBuff,SampleSize);π{ Insufficient memory for the VOC file }π IF (VoiceBuff = NIL) THEN BEGINπ Close(VFile);π VOCGetBuffer := FALSE;π VOCErrStat := 210;π EXIT;π END;π Segs := 0;π REPEATπ Blockread(VFile,Ptr(seg(VoiceBuff^)+4096*Segs,Ofs(VoiceBuff^))^,$FFFF,Readπ);π Inc(Segs);π UNTIL Read = 0;π Close(VFile);π{ File not in VOC format }π IF (TypeCastType(VoiceBuff^)[0]<>'C') ORπ (TypeCastType(VoiceBuff^)[1]<>'r') THEN BEGINπ VOCGetBuffer := FALSE;π VOCErrStat := 220;π EXIT;π END;π{ Load successful }π VOCGetBuffer := TRUE;π VOCErrStat := 0;π{ Read header length from file }π VOCFileHeaderLength := Ord(TypeCastType(VoiceBuff^)[20]);π END;πFUNCTION VOCFreeBuffer (VAR VoiceBuff : Pointer):BOOLEAN;π{* INPUT : Buffer pointerπ * OUTPUT : Noneπ * PURPOSE : Frees memory allocated for VOC data. }πBEGINπ Regs.AH := $49;π Regs.ES := seg(VoiceBuff^);π MsDos(Regs);π VOCFreeBuffer := TRUE;π IF (Regs.AX = 7) OR (Regs.AX = 9) THEN BEGINπ VOCFreeBuffer := FALSE;π VOCErrStat := 300π END;π END;πFUNCTION VOCGetVersion:WORD;π{* INPUT : Noneπ * OUTPUT : Driver version numberπ * PURPOSE : Returns driver version number. }πVARπ VDummy : WORD;πBEGINπ ASMπ MOV BX,0π CALL VOCPtrToDriverπ MOV VDummy, AXπ END;π VOCGetVersion := VDummy;π END;ππPROCEDURE VOCSetPort(PortNumber : WORD);π{* INPUT : Port address numberπ * OUTPUT : Noneπ * PURPOSE : Specifies port address before initialization. }πBEGINπ ASMπ MOV BX,1π MOV AX,PortNumberπ CALL VOCPtrToDriverπ END;π END;πPROCEDURE VOCSetIRQ(IRQNumber : WORD);π{* INPUT : Interrupt numberπ * OUTPUT : Noneπ * PURPOSE : Specifies interrupt number before initialization.}πBEGINπ ASMπ MOV BX,2π MOV AX,IRQNumberπ CALL VOCPtrToDriverπ END;π END;πFUNCTION VOCInitDriver: BOOLEAN;π{* INPUT : Noneπ * OUTPUT : Error message number, and initialization resultπ * PURPOSE : Initializes driver software. }πVARπ Out, VSeg, VOfs : WORD;π F : File;π Drivername,π Pdir : DirStr;π Pnam : NameStr;π Pext : ExtStr;πBEGINπ{ Search path for CT-VOICE.DRV driver }π Pdir := ParamStr(0);π Fsplit(ParamStr(0),Pdir,Pnam,Pext);π Drivername := Pdir+'CT-VOICE.DRV';π VOCInitDriver := TRUE;π{ Driver file not found }π IF Not Exists(Drivername) THEN BEGINπ VOCInitDriver := FALSE;π VOCErrStat := 100;π EXIT;π END;π{ Load driver }π Assign(F,Drivername);π Reset(F,1);π AllocateMem(VOCPtrToDriver,Filesize(F));π{ No memory can be allocated for the driver }π IF VOCPtrToDriver = NIL THEN BEGINπ VOCInitDriver := FALSE;π VOCErrStat := 110;π EXIT;π END;π Blockread(F,VOCPtrToDriver^,Filesize(F));π Close(F);π{ Driver file doesn't begin with "CT" - false driver }π IF (TypeCastType(VOCPtrToDriver^)[3]<>'C') ORπ (TypeCastType(VOCPtrToDriver^)[4]<>'T') THEN BEGINπ VOCInitDriver := FALSE;π VOCErrStat := 120;π EXIT;π END;π{ Get version number and pass to global variable }π VOCDriverVersion := VOCGetVersion;π{ Start driver }π Vseg := Seg(VOCStatusWord);π VOfs := Ofs(VOCStatusWord);π ASMπ MOV BX,3π CALL VOCPtrToDriverπ MOV Out,AXπ MOV BX,5π MOV ES,VSegπ MOV DI,VOfsπ CALL VOCPtrToDriverπ END;π{ No Sound Blaster card found }π IF Out = 1 THEN BEGINπ VOCInitDriver := FALSE;π VOCErrStat := 400;π EXIT;π END;π{ False port address used }π IF Out = 2 THEN BEGINπ VOCInitDriver := FALSE;π VOCErrStat := 410;π EXIT;π END;π{ False interrupt used }π IF Out = 3 THEN BEGINπ VOCInitDriver := FALSE;π VOCErrStat := 420;π EXIT;π END;π END;πPROCEDURE VOCDeInstallDriver;π{* INPUT : Noneπ * OUTPUT : Noneπ * PURPOSE : Disables driver and releases memory. }πVARπ Check : BOOLEAN;πBEGINπ IF VOCDriverInstalled THENπ ASMπ MOV BX,9π CALL VOCPtrToDriverπ END;π Check := VOCFreeBuffer(VOCPtrToDriver);π END;πPROCEDURE VOCSetSpeaker(OnOff:BOOLEAN);π{* INPUT : TRUE=Speaker on, FALSE=Speaker offπ * OUTPUT : Noneπ * PURPOSE : Sound Blaster output status. }πVARπ Switch : BYTE;πBEGINπ Switch := Ord(OnOff) AND $01;π ASMπ MOV BX,4π MOV AL,Switchπ CALL VOCPtrToDriverπ END;π END;πPROCEDURE VOCOutput (BufferAddress : Pointer);π{* INPUT : Pointer to sample dataπ * OUTPUT : Noneπ * PURPOSE : Plays sample. }πVARπ VSeg, VOfs : WORD;πBEGINπ VOCSetSpeaker(TRUE);π VSeg := Seg(BufferAddress^);π VOfs := Ofs(BufferAddress^)+VOCFileHeaderLength;π ASMπ MOV BX,6π MOV ES,VSegπ MOV DI,VOfsπ CALL VOCPtrToDriverπ END;π END;πPROCEDURE VOCOutputLoop (BufferAddress : Pointer);π{* Different from VOCOutput :π * Speaker does not switch on with every sample output, so aπ * crackling noise may occur with some Sound Blaster cards. }πVARπ VSeg, VOfs : WORD;πBEGINπ VSeg := Seg(BufferAddress^);π VOfs := Ofs(BufferAddress^)+VOCFileHeaderLength;π ASMπ MOV BX,6π MOV ES,VSegπ MOV DI,VOfsπ CALL VOCPtrToDriverπ END;π END;πPROCEDURE VOCStop;π{* INPUT : Noneπ * OUTPUT : Noneπ * PURPOSE : Stops a sample. }πBEGINπ ASMπ MOV BX,8π CALL VOCPtrToDriverπ END;π END;πPROCEDURE VOCPause;π{* INPUT : Noneπ * OUTPUT : Noneπ * PURPOSE : Pauses a sample. }πVARπ Switch : WORD;πBEGINπ VOCPaused := TRUE;π ASMπ MOV BX,10π CALL VOCPtrToDriverπ MOV Switch,AXπ END;π IF (Switch = 1) THEN BEGINπ VOCPaused := FALSE;π VOCErrStat := 510;π END;π END;πPROCEDURE VOCContinue;π{* INPUT : Noneπ * OUTPUT : Noneπ * PURPOSE : Continues a paused sample. }πVARπ Switch : WORD;πBEGINπ ASMπ MOV BX,11π CALL VOCPtrToDriverπ MOV Switch,AXπ END;π IF (Switch = 1) THEN BEGINπ VOCPaused := FALSE;π VOCErrStat := 520;π END;π END;πPROCEDURE VOCBreakLoop(BreakMode : WORD);π{* INPUT : Break modeπ * OUTPUT : Noneπ * PURPOSE : Breaks a sample loop. }πBEGINπ ASMπ MOV BX,12π MOV AX,BreakModeπ CALL VOCPtrToDriverπ MOV BreakMode,AXπ END;π IF (BreakMode = 1) THEN VOCErrStat := 500;π END;π{$F+}πPROCEDURE VoiceToolsExitProc;π{$F-}π{* INPUT : Noneπ * OUTPUT : Noneπ * PURPOSE : De-installs voice driver. }πBEGINπ VOCDeInstallDriver;π ExitProc := OldExitProc;π END;πBEGINπ{* The following statements execute automatically, as soon as theπ * unit is linked to a program, and the program starts. }π{ Replaces old ExitProc with new one from Tool unit }π OldExitProc := ExitProc;π ExitProc := @VoiceToolsExitProc;π{ Initialize values }π VOCStatusWord := 0;π VOCErrStat := 0;π VOCPaused := FALSE;π VOCFileHeaderLength := $1A;π VOCFileHeader :=π 'Creative Voice File'+#$1A+#$1A+#$00+#$0A+#$01+#$29+#$11+#$01;π{* After installation, VOCDriverInstalled contains either TRUE or FALSE. }π VOCDriverInstalled := VOCInitDriver;π END.πππ{ ----------------------- DEMO PROGRAM --------------------------}ππPROGRAM VToolTest;π{* VTTEST.PAS - uses VOCTOOL.TPU *}ππ{$M 16000,0,50000}πUSES Crt,Voctool;πVARπ Sound : Pointer;π Check : BOOLEAN;π Ch : CHAR;πPROCEDURE TextNumError;π{* INPUT : None; data comes from the VOCErrStat global variableπ * OUTPUT : Noneπ * PURPOSE : Displays SB error on the screen as text, including theπ error number. Program then ends at the error levelπ corresponding to the error number. }πBEGINπ Write(' Error #',VOCErrStat:3,' =');π PrintVOCErrMessage;π WriteLn;π HALT(VOCErrStat);π END;ππBEGINπ ClrScr;ππ{ Driver not initialized }π IF Not(VOCDriverInstalled) THEN TextNumError;π{ Loads DEMO.VOC file into memory }π Check := VOCGetBuffer(Sound,'\SBPRO\MMPLAY\SBP.VOC');π{ VOC file could not be loaded }π IF Not(Check) THEN TextNumError;π{ Main loop }π Write('CT-Voice Driver Version : ');π WriteLn(Hi(VOCDriverVersion),'.',Lo(VOCDriverVersion));π WriteLn('(S)ingle play or (M)ultiple play?');π Write('Press a key : '); Ch := ReadKey;WriteLn;WriteLn;π CASE UpCase(Ch) OFπ 'S' : BEGINπ Write('Press a key to stop the sound...');π VOCOutput(Sound);π REPEAT UNTIL KeyPressed OR (VOCStatusWord = 0);π IF KeyPressed THEN VOCStop;π END;π 'M' : BEGINπ Ch := #0;π Write('Press <ESC> to cancel...');π REPEATπ VOCOutputLoop(Sound);π REPEAT UNTIL KeyPressed OR (VOCStatusWord = 0);π IF KeyPressed THEN Ch := ReadKey;π UNTIL Ch = #27;π VOCStop;π END;π END;π{ Free VOC file memory }π Check := VOCFreeBuffer(Sound);π IF Not(Check) THEN TextNumError;π END.π 23 08-17-9308:50ALL STEVE WIERENGA Control Speaker IMPORT 23 ■"Qc ===========================================================================π BBS: Canada Remote SystemsπDate: 07-11-93 (13:22) Number: 30113πFrom: STEVE WIERENGA Refer#: NONEπ To: TRAVIS GRIGGS Recvd: NO πSubj: SPEAKER(OFF) Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πHello Travis:ππ >> { untested, but should work }π >> {$M 1024,0,0}π >> {$F+}π >> uses DOS;π >> Varπ >> Old1C : Procedure;π TG>π >> Procedure SpeakerOff; Interrupt;π >> Beginπ >> ASM { no sound proc, removes need to use CRT unit in a TSR }π >> mov dx,061hπ >> in al,dxπ >> and al,11111100bπ >> out dx,alπ >> pushfπ >> End;π >> Old1C;π >> End;π TG>π >> Beginπ >> GetIntVec ($1C,@Old1C);π >> SetIntVec ($1C,@SpeakerOff);π >> Keep(0);π >> End.π TG>π TG> I'm trying to learn to write a TSR. Could you explain every step andπ TG> why it's there? Thanks...ππI didn't write that code, actually. I have never written a TSR and don't planπto in the near future, so I suggest you ask one of the gurus here.ππ >> --- FMail 0.90π TG>π TG> Fmail 0.94 is out. You should get it. It's much better...ππI'm still with .90 because I can't afford to register .94 (.90 doesn't have aπregistration) :-(.πTake Care, SteveπShockwave Software Systemsππ--- FMail 0.90π * Origin: The Programmer's Armpit... Home of Monsoon*Qomm! (1:2613/228.2)π===========================================================================π BBS: Canada Remote SystemsπDate: 07-10-93 (11:08) Number: 30157πFrom: STEVEN TALLENT Refer#: NONEπ To: NIELS LANGKILDE Recvd: NO πSubj: RE: SPEAKER(OFF) Conf: (1221) F-PASCALπ---------------------------------------------------------------------------π -=> Quoting Niels Langkilde to Everyone <=-ππ NL> Is it possible to diable/enable the speaker output (alternatvlyπ NL> redirect it) ?? If so, please help !ππThe only thing that can be done is disabling the speaker many timesπa second to do it. Here's some code that disables it 18 times a second,πbut notably does NOT work with programs that shut down interruptsπduring playback.ππ{$M 1024,0,0}π{$N-,S-,G+} { Use g- for 8088 systems, g+ for V20 and above }πPROGRAM NoSpeak;πUSES Dos;πVAR OLDINT1C : Procedure;ππPROCEDURE ShutOff; INTERRUPT;πBEGINπ Port [97] := Port[97] and 253; {Turn off speaker}π OldInt1C;π end;ππBEGINπ GetIntVec($1C, @OldInt1C);π SetIntVec($1C, @ShutOff);π Keep(0);π end.ππNote this is a TSR, and I can't guarantee that it'll work right onπanyone's computer.ππ___ Blue Wave/QWK v2.12π--- Renegade v06-25 Betaπ * Origin: Pink's Place (409)883-8344 735-3712 (1:3811/210)π 24 08-27-9319:58ALL STEVEN TALLEN 8bit raw sounds IMPORT 49 ■" {ππ SoundS.INC 5-27-93 by Steven TallentππThis is a Unit to play 8-bit raw Sound Files on any PC, up to 64kπlarge. It supports the PC speaker or a DAC (LPT1 or LPT2), althoughπI do plan to upgrade it to support the SoundBlaster and Adlib Soundπcards. It is Object-oriented in nature, With one instance of aπspeaker defined automatically. This Unit is public domain, Withπcode and ideas captured from this echo and Dr. Dobbs Journal.ππUsing the code is simple. Just setup the the Speaker.Kind,πSpeaker.Silent, and Speaker.DisINT to the appropriate values, thenπjust use the methods included. The SoundBoard Object is veryπflexible For your own code.ππSoundBoard.Play - Plays 8-bit music in What^ For Size length, Withπ Speed milliseconds between each Byte, and SampleRateπ as the sample rate (in Hz). Speed will need to beπ changed on different computers (of course).ππSoundBoard.Sound - Plays a Sound at HZ Hertz, Duration in ms, onπ VOICE voice. The code included is useable onπ the PC speaker (1 voice) or the Tandy speakerπ (3 voices!).ππSoundBoard.Reset - Resets the Sound board.ππSoundBoard.Silent- Convenient Variable that disables all PLAY and Soundπ if set to True.ππSoundBoard.DisINT- Disables all interrupts (except during Delays)π While using PLAY.ππThis code may be freely distributed, changed, or included in yourπown commercial or shareware code, as long as this isn't all your codeπdoes. This code may be included in commercial or shareware codeπlibraries only With my permission (I'd like to see someone get someπuse out of it).π}ππUnit Sounds;ππInterfaceππTypeπ BigArray = Array[0..0] of Byte;π PBigArray = ^BigArray;π KSoundBoard = (PCspeaker, Tandy, DAC1, DAC2, AdLib, SB, SBpro, SB16);ππ SoundBoard = Objectπ Kind : KSoundBoard;π Silent : Boolean;π DisINT : Boolean;π Procedure Play(What : PBigArray; Size : Word; Speed : Byte;π SampleRate : Word);π Procedure Sound(Hz, Duration : Word; Voice, Volume : Byte);π Procedure Reset;π end;ππVarπ Speaker : SoundBoard;ππProcedure Delay(ms : Word);ππImplementationππProcedure SoundBoard.Reset;πbeginπ Case Kind ofπ PCspeaker, Tandy : Port[97] := Port[97] and $FC;π end;π end;ππProcedure SoundBoard.Sound(Hz, Duration : Word; Voice, Volume : Byte);πVarπ Count : Word;π SendByte,π VoiceID : Byte;πbeginπ Case Kind ofπ PCspeaker :π beginπ Count := 1193180 div Hz;π Port[97] := Port[97] or 3;π Port[67] := 182;π Port[66] := Lo(Count);π Port[66] := Hi(Count);π Delay(Duration);π Port[97] := Port[97] and $FC;π end;π Tandy :π beginπ if Voice = 1 thenπ VoiceId := 0π elseπ if Voice = 2 thenπ VoiceId := 32π elseπ VoiceId := 64;π Count := 111861 div Hz;π SendByte := 128 + VoiceId + (Count mod 16);π Port [$61] := $68;π Port [$C0] := SendByte;π Port [$C0] := Count div 16;π if Voice = 1 thenπ VoiceId := 16π elseπ if Voice = 2 thenπ VoiceId := 48π elseπ VoiceId := 96;π SendByte := 128 + VoiceId + (15 - Volume);π Port [$61] := $68;π Port [$C0] := SendByte;π Delay(Duration);π SendByte := 128 + VoiceId + 15;π Port [$61] := $68;π Port [$C0] := SendByte;π DAC1:;π DAC2:;π AdLib:;π SB:;π SBPro:;π SB16:;π end;ππProcedure SoundBoard.Play(What : PBigArray; Size : Word;π Speed : Byte; SampleRate : Word);πVarπ Loop,π Count,π Data : Word;πbeginπ if not Silent thenπ beginπ Case Kind ofπ PCspeaker, Tandy :π beginπ Port[97] := Port[97] or 3;π Count := 1193180 div (SampleRate div 256);π For Loop := 1 to Size doπ beginπ Data := Count div (What^[Loop] + 1);π Port[67] := 182;π Port[66] := Lo(Data);π Port[66] := Hi(Data);π Delay(Speed);π if DisINT thenπ Asmπ CLIπ end;π end;π Port[97] := Port[97] and $FC;π end;ππ DAC1:π For Loop := 1 to Size doπ beginπ Port [$0378] := What^[Loop];π Delay (Speed);π if DisINT thenπ Asmπ CLIπ end;π end;ππ DAC2:π For Loop := 1 to Size doπ beginπ Port [$0278] := What^[Loop];π Delay (Speed);π if DisINT thenπ Asmπ CLIπ end;π end;ππ AdLib:;π SB:;π SBPro:;π SB16:;π end;π Asmπ STIπ end;π end;πend;ππProcedure Delay(ms : Word); Assembler;πAsmπ STIπ MOV AH, $86π MOV CX, 0π MOV DX, [ms]π INT $15πend;ππend.ππ{-----------------------------------------------------------------πHere's a Program that will accept three values from the commandπline, the File, its speed, and the sample rate, and plays itπthrough the PC speaker. I've tried in on WAV, VOC, SAM, and evenπAmiga sampled Files, With no problems (limited to 64k). I've evenπplayed MOD Files to hear all the sampled instruments! This Programπdoes not strip header information, but plays it too, but I can'tπhear the difference on WAV and VOC Files.π}πProgram TestSnd;πUsesπ Sounds;πVarπ I2 : PBigArray;π spd : Integer;π samp : Word;π res : Word;π siz : Word;π s : String;π f1 : File of Byte;π F : File;πbeginπ Speaker.Kind := PCspeaker;π Speaker.DisINT := True;π Speaker.Silent := False;π s := ParamStr(1);π Assign(f1,s); {Get size of File}π Reset(f1);π Val (ParamStr(2), Spd, Res);π Val (ParamStr(3), samp, Res);π siz := FileSize(f1);π close(f1);π Assign(f,s);π Reset(f);π getmem (I2,siz); {Allocate Memory For Sound File}π BlockRead(f,I2^,siz,res); {Load Sound into Memory}π Speaker.Play (i2, siz, spd, samp);π FreeMem (I2, siz);πend.π 25 08-27-9320:23ALL NICHOLAS KIRSH CDRom Audio Disk Player IMPORT 34 ■" {πNICHOLAS KIRSCHππHere is some source For using CD-ROM's With Pascal, if you get TP7,πit's still compatible.ππ{ Copyright 1993 by Michael W. Armstrong.π 2800 Skipwith Rdπ Richmond, VA 23294ππ Compuserve ID 72740, 1145π This Program is entered as Shareware. if you find it useful, a smallπ donation would be appreciated. Feel free to incorporate the code intoπ your own Programs.π}ππ{$X+}πProgram CDPlay;ππ{$IfDef Windows}π{$C PRELOAD}πUsesπ CD_Vars,π CDUnit_P,π WinCrt,π WinProcs;π{$else}πUsesπ CD_Vars,π CDUnit_P,π Crt,π Drivers;π{$endIf}ππTypeπ TotPlayRec = Recordπ Frames,π Seconds,π Minutes,π Nada : Byte;π end;ππVarπ GoodDisk : Boolean;π SaveExit : Pointer;π OldMode : Word;π CurrentTrack,π StartTrack,π endTrack : Integer;π TotPlay : TotPlayRec;π TrackInfo : Array [1..99] of PAudioTrackInfo;ππFunction LeadingZero(w : Word) : String;πVarπ s : String;πbeginπ Str(w : 0, s);π LeadingZero := Copy('00', 1, 2 - Length(s)) + s;πend;ππProcedure DrawScreen;πConstπ TStr = '%03d:%02d';π VStr = '%1d.%2d';πVarπ FStr : PChar;π NStr : String;π Param : Array [1..2] of LongInt;π Code : Integer;πbeginπ WriteLn('CD ROM Audio Disk Player');π WriteLn('Copyright 1992 by M. W. ARMSTRONG');π Param[1] := MSCDEX_Version.Major;π Param[2] := MSCDEX_Version.Minor;ππ{$IfDef Windows}π wvsPrintf(FStr, VStr, Param);π{$else}π FormatStr(NStr, VStr, Param);π{$endIf}ππ WriteLn('MSCDEX Version ', NStr);π Str(NumberOfCD, NStr);π WriteLn('Number of CD ROM Drives is: ' + Nstr);π WriteLn('First CD Drive Letter is : ' + Chr(FirstCD + 65));π WriteLn('There are ' + LeadingZero(endTrack - StartTrack + 1) +π ' Tracks on this disk');π Code := 1;πend;π{***********************************************************************}ππ{***********************************************************************}πππProcedure Setup;πVarπ LeadOut,π StartP,π TotalPlayTime : LongInt;π I : Integer;π A, B, C : LongInt;π Track : Byte;π EA : Array [1..4] of Byte;π SP, EP : LongInt;ππbeginπ FillChar(AudioDiskInfo, SizeOf(AudioDiskInfo), #0);π DeviceStatus;π if Audio thenπ beginπ Audio_Disk_Info;π TotalPlayTime := 0;π LeadOut := AudioDiskInfo.LeadOutTrack;ππ StartTrack := AudioDiskInfo.LowestTrack;π endTrack := AudioDiskInfo.HighestTrack;π CurrentTrack := StartTrack;π I := StartTrack - 1;ππ Repeat { Checks if Audio Track or Data Track }π Inc(I);π Track := I;π Audio_Track_Info(StartP, Track);π Until (Track and 64 = 0) or (I = endTrack);ππ StartTrack := I;ππ For I := StartTrack to endTrack DOπ beginπ Track := I;π Audio_Track_Info(StartP, Track);π New(TrackInfo[I]);π FillChar(TrackInfo[I]^, SizeOf(TrackInfo[I]^), #0);π TrackInfo[I]^.Track := I;π TrackInfo[I]^.StartPoint := StartP;π TrackInfo[I]^.TrackControl := Track;π end;ππ For I := StartTrack to endTrack - 1 DOπ TrackInfo[I]^.endPoint := TrackInfo[I+1]^.StartPoint;π TrackInfo[endTrack]^.endPoint := LeadOut;ππ For I := StartTrack to endTrack DOπ Move(TrackInfo[I]^.endPoint, TrackInfo[I]^.Frames, 4);ππ TrackInfo[StartTrack]^.PlayMin := TrackInfo[StartTrack]^.Minutes;π TrackInfo[StartTrack]^.PlaySec := TrackInfo[StartTrack]^.Seconds - 2;ππ For I := StartTrack + 1 to endTrack DOπ beginπ EP := (TrackInfo[I]^.Minutes * 60) + TrackInfo[I]^.Seconds;π SP := (TrackInfo[I-1]^.Minutes * 60) + TrackInfo[I-1]^.Seconds;π EP := EP - SP;π TrackInfo[I]^.PlayMin := EP div 60;π TrackInfo[I]^.PlaySec := EP Mod 60;π end;ππ TotalPlayTime := AudioDiskInfo.LeadOutTrack -π TrackInfo[StartTrack]^.StartPoint;π Move(TotalPlayTime, TotPlay, 4);π end;πend;ππ{***********************************************************************}πππbeginπ Setup;π if Audio thenπ if Playing thenπ StopAudioπ elseπ beginπ StopAudio;π Play_Audio(TrackInfo[StartTrack]^.StartPoint,π TrackInfo[endTrack]^.endPoint);π Audio_Status_Info;π DrawScreen;π endπ elseπ WriteLn('This is not an Audio CD');π WriteLn('UPC Code is: ', UPC_Code);πend.π 26 08-27-9320:24ALL NICHOLAS KIRSH VARS for CDRom Player IMPORT 25 ■" { NICHOLAS KIRSCH }ππUnit CD_Vars;ππInterfaceππTypeπ ListBuf = Recordπ UnitCode : Byte;π UnitSeg,π UnitOfs : Word;π end;ππ VTOCArray = Array [1..2048] of Byte;π DriveByteArray = Array [1..128] of Byte;ππ Req_Hdr = Recordπ Len : Byte;π SubUnit : Byte;π Command : Byte;π Status : Word;π Reserved: Array [1..8] of Byte;π End;ππConstπ Init = 0;π IoCtlInput = 3;π InputFlush = 7;π IOCtlOutput = 12;π DevOpen = 13;π DevClose = 14;π ReadLong = 128;π ReadLongP = 130;π SeekCmd = 131;π PlayCD = 132;π StopPlay = 133;π ResumePlay = 136;ππTypeππ Audio_Play = Recordπ APReq : Req_Hdr;π AddrMode : Byte;π Start : LongInt;π NumSecs : LongInt;π end;ππ IOControlBlock = Recordπ IOReq_Hdr : Req_Hdr;π MediaDesc : Byte;π TransAddr : Pointer;π NumBytes : Word;π StartSec : Word;π ReqVol : Pointer;π TransBlock : Array [1..130] OF Byte;π End;ππ ReadControl = Recordπ IOReq_Hdr : Req_Hdr;π AddrMode : Byte;π TransAddr : Pointer;π NumSecs : Word;π StartSec : LongInt;π ReadMode : Byte;π IL_Size,π IL_Skip : Byte;π End;ππ AudioDiskInfoRec = Recordπ LowestTrack : Byte;π HighestTrack : Byte;π LeadOutTrack : LongInt;π End;ππ PAudioTrackInfo = ^AudioTrackInfoRec;π AudioTrackInfoRec = Recordπ Track : Integer;π StartPoint : LongInt;π EndPoint : LongInt;π Frames,π Seconds,π Minutes,π PlayMin,π PlaySec,π TrackControl : Byte;π end;ππ MSCDEX_Ver_Rec = Recordπ Major,π Minor : Integer;π End;ππ DirBufRec = Recordπ XAR_Len : Byte;π FileStart : LongInt;π BlockSize : Integer;π FileLen : LongInt;π DT : Byte;π Flags : Byte;π InterSize : Byte;π InterSkip : Byte;π VSSN : Integer;π NameLen : Byte;π NameArray : Array [1..38] of Char;π FileVer : Integer;π SysUseLen : Byte;π SysUseData: Array [1..220] of Byte;π FileName : String[38];π end;ππ Q_Channel_Rec = Recordπ Control : Byte;π Track : Byte;π Index : Byte;π Minutes : Byte;π Seconds : Byte;π Frame : Byte;π Zero : Byte;π AMinutes : Byte;π ASeconds : Byte;π AFrame : Byte;π End;ππVarπ AudioChannel : Array [1..9] of Byte;π RedBook,π Audio,π DoorOpen,π DoorLocked,π AudioManip,π DiscInDrive : Boolean;π AudioDiskInfo : AudioDiskInfoRec;π DriverList : Array [1..26] of ListBuf;π NumberOfCD : Integer;π FirstCD : Integer;π UnitList : Array [1..26] of Byte;π MSCDEX_Version : MSCDEX_Ver_Rec;π QChannelInfo : Q_Channel_Rec;π Busy,π Playing,π Paused : Boolean;π Last_Start,π Last_End : LongInt;π DirBuf : DirBufRec;ππImplementationππBeginπ FillChar(DriverList, SizeOf(DriverList), #0);π FillChar(UnitList, SizeOf(UnitList), #0);π NumberOfCD := 0;π FirstCD := 0;π MSCDEX_Version.Major := 0;π MSCDEX_Version.Minor := 0;πend.π 27 08-27-9321:36ALL SWAG SUPPORT TEAM Lots of Sound IMPORT 150 ■" {πI've gotten tired of writing these routines and have gone on to otherπprojects so I don't have time to work on them now. I figured others may getπsome use out of them though. They're not totally done yet, but what is thereπdoes work (as far as I can tell). They support playing digitized Soundπ(signed or unsigned) at sample rates from 18hz to 44.1khz (at least on myπ386sx/25), on the PC Speaker (polled), LPT DACs (1-4) or Adlib FM channels. Iπwas planning on adding Sound Blaster DAC, Gravis UltraSound, and PC Speakerπ(pulse width modulated) support. I also planned on adding VOC support. Iπmay add those at a later date, but no promises. I'll release any new updatesπ(if there are any) through the PDN since these routines are a little longπ(this will be the ONLY post of these routines in this echo). I haven'tπtested the LPT DAC routines, so could someone who has an LPT DAC please testπthem and let me know if they work? (They SHOULD work, but you never know.)πThese routines work For me under Turbo Pascal V6.0 on my 386sx/25.π}ππUnit Digital;π(*************************************************************************)π(* *)π(* Programmed by David Dahl *)π(* This Unit and all routines are PUBLIC DOMAIN. *)π(* *)π(* Special thanks to Emil Gilliam For information (and code!) on Adlib *)π(* digital output. *)π(* *)π(* if you use any of these routines in your own Programs, I would *)π(* appreciate an acknowledgement in the docs and/or Program... and I'm *)π(* sure Mr. Gilliam wouldn't Object to having his name mentioned, too. *)π(* *)π(*************************************************************************)πInterfaceππConstπ BufSize = 2048;ππTypeπ BufferType = Array[1 .. BufSize] of Byte;π BufPointer = ^BufferType;ππ DeviceType = (LPT1, LPT2, LPT3, LPT4, PcSpeaker, PCSpeakPW, Adlib,π SoundBlaster, UltraSound);ππVarπ DonePlaying : Boolean;ππProcedure SetOutPutDevice(DeviceName : DeviceType; SignedSamples : Boolean);πProcedure SetPlaySpeed(Speed : LongInt);ππProcedure PlayRAWSoundFile(FileName : String; SampleRate : Word);πFunction LoadBuffer(Var F : File; Var BufP : BufPointer) : Word;πProcedure PlayBuffer(BufPtr : BufPointer; Size : Word);ππProcedure HaltPlaying;πProcedure CleanUp;ππImplementationππUsesπ Crt;ππConstπ C8253ModeControl = $43;π C8253Channel : Array [0..2] of Byte = ($40, $41, $42);π C8253OperatingFreq = 1193180;π C8259Command = $20;ππ TimerInterrupt = $08;π AdlibIndex = $388;π AdlibReg = $389;ππTypeπ ZeroAndOne = 0..1;ππVarπ DataLength : Word;π Buffer : BufPointer;ππ LPTAddress : Word;π LPTPort : Array [1 .. 4] of Word Absolute $0040 : $0008;ππ OldTimerInterrupt : Pointer;π InterruptVector : Array [0..255] of Pointer Absolute $0000 : $0000;ππ{=[ Misc Procedures ]=====================================================}ππ{-[ Clear Interrupt Flag (Disable Maskable Interrupts) ]------------------}πProcedure CLI;πInline($FA);ππ{-[ Set Interrupt Flag ]--------------------------------------------------}πProcedure STI;πInline($FB);πππ{=[ Initialize Sound Devices ]============================================}ππ{-[ Initialize Adlib FM For Digital Output ]------------------------------}πProcedure InitializeAdlib;πVarπ TempInt : Pointer;ππ Procedure Adlib(Reg, Data : Byte); Assembler;π Asmπ mov dx, AdlibIndex { Adlib index port }π mov al, Regππ out dx,al { Set the index }ππ { Wait For hardware to respond }π in al, dx; in al, dx; in al, dxπ in al, dx; in al, dx; in al, dxππ inc dx { Adlib register port }π mov al, Dataπ out dx, al { Set the register value }ππ dec dx { Adlib index port }ππ { Wait For hardware to respond }π in al, dx; in al, dx; in al, dx; in al, dx; in al, dxπ in al, dx; in al, dx; in al, dx; in al, dx; in al, dxπ in al, dx; in al, dx; in al, dx; in al, dx; in al, dxπ in al, dx; in al, dx; in al, dx; in al, dx; in al, dxπ in al, dx; in al, dx; in al, dx; in al, dx; in al, dxπ in al, dx; in al, dx; in al, dx; in al, dx; in al, dxπ in al, dx; in al, dx; in al, dx; in al, dx; in al, dxππ end;ππbeginπ Adlib($00, $00); { Set Adlib test Register }π Adlib($20, $21); { Operator 0: MULTI=1, AM=VIB=KSR=0, EG=1 }π Adlib($60, $F0); { Attack = 15, Decay = 0 }π Adlib($80, $F0); { Sustain = 15, Release = 0 }π Adlib($C0, $01); { Feedback = 0, Additive Synthesis = 1 }π Adlib($E0, $00); { Waveform = Sine Wave }π Adlib($43, $3F); { Operator 4: Total Level = 63, Attenuation = 0 }π Adlib($B0, $01); { Fnumber = 399 }π Adlib($A0, $8F);π Adlib($B0, $2E); { FNumber = 143, Key-On }ππ { Wait For the operator's sine wave to get to top and then stop it thereπ That way, we have an operator who's wave is stuck at the top, and we canπ play digitized Sound by changing it's total level (volume) register. }ππ Asmπ mov al, 0 { Get timer 0 value into DX }π out 43h, alπ jmp @Delay1ππ @Delay1:π in al, 40hπ mov dl, alπ jmp @Delay2ππ @Delay2:π in al, 40hππ mov dh, alπ sub dx, 952h { Target value }ππ @wait_loop:π mov al, 0 { Get timer 0 value into BX }π out 43h, alπ jmp @Delay3ππ @Delay3:π in al, 40hπ mov bl, alπ jmp @Delay4ππ @Delay4:π in al, 40hπ mov bh, alπ cmp bx, dx { Have we waited that much time yet? }π ja @wait_loop { if no, then go back }ππ end;ππ { Now that the sine wave is at the top, change its frequency to 0 to keepπ it from moving }ππ Adlib($B0, $20); { F-Number = 0 }π Adlib($A0, $00); { Frequency = 0 }ππ Port[AdlibIndex] := $40;πend;ππ{=[ Sound Device Handlers ]===============================================}πProcedure PlayPCSpeaker; Interrupt;πConstπ Counter : Word = 1;πbeginπ if Not(DonePlaying) Thenπ beginπ if Counter <= DataLength Thenπ beginπ Port[$61] := (Port[$61] and 253) OR ((Buffer^[Counter] and 128) SHR 6);π Inc(Counter);π endπ elseπ beginπ DonePlaying := True;π Counter := 1;π end;π end;ππ Port[C8259Command] := $20; { Enable Interrupts }πend;ππProcedure PlayPCSpeakerSigned; Interrupt;πConstπ Counter : Word = 1;πbeginπ if Not(DonePlaying) Thenπ beginπ if Counter <= DataLength Thenπ beginπ Port[$61] := (Port[$61] and 253) ORπ ((Byte(shortint(Buffer^[Counter]) + 128) AND 128) SHR 6);π Inc(Counter);π endπ elseπ beginπ DonePlaying := True;π Counter := 1;π end;π end;ππ Port[C8259Command] := $20; { Enable Interrupts }πend;ππProcedure PlayLPT; Interrupt;πConstπ Counter : Word = 1;πbeginπ if Not(DonePlaying) Thenπ beginπ if Counter <= DataLength Thenπ beginπ Port[LPTAddress] := Buffer^[Counter];π Inc(Counter);π endπ elseπ beginπ DonePlaying := True;π Counter := 1;π end;π end;ππ Port[C8259Command] := $20; { Enable Interupts }πend;ππProcedure PlayLPTSigned; Interrupt;πConstπ Counter : Word = 1;πbeginπ if Not(DonePlaying) Thenπ beginπ if Counter <= DataLength Thenπ beginπ Port[LPTAddress] := Byte(shortint(Buffer^[Counter]) + 128);π Inc(Counter);π endπ elseπ beginπ DonePlaying := True;π Counter := 1;π end;π end;ππ Port[C8259Command] := $20; { Enable Interupts }πend;ππProcedure PlayAdlib; Interrupt;πConstπ Counter : Word = 1;πbeginπ if Not(DonePlaying) Thenπ beginπ if Counter <= DataLength Thenπ beginπ Port[AdlibReg] := (Buffer^[Counter] SHR 2);π Inc(Counter);π endπ elseπ beginπ DonePlaying := True;π Counter := 1;π end;π end;ππ Port[C8259Command] := $20; { Enable Interupts }πend;ππProcedure PlayAdlibSigned; Interrupt;πConstπ Counter : Word = 1;πbeginπ if Not(DonePlaying) Thenπ beginπ if Counter <= DataLength Thenπ beginπ Port[AdlibReg] := Byte(shortint(Buffer^[Counter]) + 128) SHR 2;π Inc(Counter);π endπ elseπ beginπ DonePlaying := True;π Counter := 1;π end;π end;ππ Port[C8259Command] := $20; { Enable Interupts }πend;ππ{=[ 8253 Timer Programming Routines ]=====================================}πProcedure Set8253Channel(ChannelNumber : Byte; ProgramValue : Word);πbeginπ Port[C8253ModeControl] := 54 or (ChannelNumber SHL 6); { XX110110 }π Port[C8253Channel[ChannelNumber]] := Lo(ProgramValue);π Port[C8253Channel[ChannelNumber]] := Hi(ProgramValue);πend;ππ{-[ Set Clock Channel 0 (INT 8, IRQ 0) To Input Speed ]-------------------}πProcedure SetPlaySpeed(Speed : LongInt);πVarπ ProgramValue : Word;πbeginπ ProgramValue := C8253OperatingFreq div Speed;π Set8253Channel(0, ProgramValue);πend;ππ{-[ Set Clock Channel 0 Back To 18.2 Default Value ]----------------------}πProcedure SetDefaultTimerSpeed;πbeginπ Set8253Channel (0, 0);πend;πππ{=[ File Handling ]=======================================================}ππ{-[ Load Buffer With Data From Raw File ]---------------------------------}πFunction LoadBuffer(Var F : File; Var BufP : BufPointer) : Word;πVarπ NumRead : Word;πbeginπ BlockRead(F, BufP^, BufSize, NumRead);π LoadBuffer := NumRead;πend;πππ{=[ Sound Playing / Setup Routines ]======================================}ππ{-[ Output Sound Data In Buffer ]-----------------------------------------}πProcedure PlayBuffer(BufPtr : BufPointer; Size : Word);πbeginπ Buffer := BufPtr;π DataLength := Size;π DonePlaying := False;πend;ππ{-[ Halt Playing ]--------------------------------------------------------}πProcedure HaltPlaying;πbeginπ DonePlaying := True;πend;ππ{=[ Initialize Data ]=====================================================}πProcedure InitializeData;πConstπ CalledOnce : Boolean = False;πbeginπ if Not(CalledOnce) Thenπ beginπ DonePlaying := True;π OldTimerInterrupt := InterruptVector[TimerInterrupt];π CalledOnce := True;π end;πend;ππ{=[ Set Interrupt Vectors ]===============================================}ππ{-[ Set Timer Interrupt Vector To Our Device ]----------------------------}πProcedure SetOutPutDevice(DeviceName : DeviceType; SignedSamples : Boolean);πbeginπ CLI;ππ Case DeviceName ofππ LPT1..LPT4 :π beginπ LPTAddress := LPTPort[Ord(DeviceName)];π if SignedSamples Thenπ InterruptVector[TimerInterrupt] := @PlayLPTSignedπ elseπ InterruptVector[TimerInterrupt] := @PlayLPT;π end;ππ PCSpeaker :π if SignedSamples Thenπ InterruptVector[TimerInterrupt] := @PlayPCSpeakerSignedπ elseπ InterruptVector[TimerInterrupt] := @PlayPCSpeaker;ππ Adlib :π beginπ InitializeAdlib;π if SignedSamples Thenπ InterruptVector[TimerInterrupt] := @PlayAdlibSignedπ elseπ InterruptVector[TimerInterrupt] := @PlayAdlib;π end;ππ elseπ beginπ STI;ππ Writeln;π Writeln ('That Sound Device Is Not Supported In This Version.');π Writeln ('Using PC Speaker In Polled Mode Instead.');ππ CLI;π if SignedSamples Thenπ InterruptVector[TimerInterrupt] := @PlayPCSpeakerSignedπ elseπ InterruptVector[TimerInterrupt] := @PlayPCSpeaker;π end;π end;π STI;πend;ππ{-[ Set Timer Interupt Vector To Default Handler ]------------------------}πProcedure SetTimerInterruptVectorDefault;πbeginπ CLI;π InterruptVector[TimerInterrupt] := OldTimerInterrupt;π STI;πend;ππProcedure PlayRAWSoundFile(FileName : String; SampleRate : Word);πVarπ RawDataFile : File;π SoundBuffer : Array [ZeroAndOne] of BufPointer;π BufNum : ZeroAndOne;π Size : Word;πbeginπ New(SoundBuffer[0]);π New(SoundBuffer[1]);ππ SetPlaySpeed(SampleRate);ππ Assign(RawDataFile, FileName);π Reset(RawDataFile, 1);ππ BufNum := 0;π Size := LoadBuffer(RawDataFile, SoundBuffer[BufNum]);ππ PlayBuffer(SoundBuffer[BufNum], Size);ππ While Not(Eof(RawDataFile)) doπ beginπ BufNum := (BufNum + 1) and 1;π Size := LoadBuffer(RawDataFile, SoundBuffer[BufNum]);ππ Repeat Until DonePlaying;ππ PlayBuffer(SoundBuffer[BufNum], Size);π end;ππ Close (RawDataFile);ππ Repeat Until DonePlaying;ππ SetDefaultTimerSpeed;ππ Dispose(SoundBuffer[1]);π Dispose(SoundBuffer[0]);πend;ππ{=[ MUST CALL BEFORE ExitING Program!!! ]=================================}πProcedure CleanUp;πbeginπ SetDefaultTimerSpeed;π SetTimerInterruptVectorDefault;πend;ππ{=[ Set Up ]==============================================================}πbeginπ InitializeData;π NoSound;πend.ππππππππProgram RAWDigitalOutput;ππ(*************************************************************************)π(* *)π(* Programmed by David Dahl *)π(* This Program and all routines are PUBLIC DOMAIN. *)π(* *)π(* if you use any of these routines in your own Programs, I would *)π(* appreciate an acknowledgement in the docs and/or Program. *)π(* *)π(*************************************************************************)ππUsesπ Crt,π Digital;ππTypeπ String4 = String[4];π String35 = String[35];ππConstπ MaxDevices = 9;ππ DeviceCommand : Array [1..MaxDevices] of String4 =π ('-L1', '-L2', '-L3', '-L4',π '-P' , '-PM', '-A' , '-SB', '-GUS' );ππ DeviceName : Array [1..MaxDevices] of String35 =π ('LPT DAC on LPT1',π 'LPT DAC on LPT2',π 'LPT DAC on LPT3',π 'LPT DAC on LPT4',π 'PC Speaker (Polled Mode)',π 'PC Speaker (Pulse Width Modulated)',π 'Adlib / SoundBlaster FM',π 'SoundBlaster DAC',π 'Gravis UltraSound');ππ SignedUnsigned : Array [False .. True] of String35 =π ('Unsigned Sample', 'Signed Sample');πππ{-[ Return An All Capaitalized String ]-----------------------------------}πFunction UpString(StringIn : String) : String;πVarπ TempString : String;π Counter : Byte;πbeginπ TempString := '';π For Counter := 1 to Length (StringIn) doπ TempString := TempString + UpCase(StringIn[Counter]);ππ UpString := TempString;πend;ππ{-[ Check if File Exists ]------------------------------------------------}πFunction FileExists(FileName : String) : Boolean;πVarπ F : File;πbeginπ {$I-}π Assign (F, FileName);π Reset(F);π Close(F);π {$I+}π FileExists := (IOResult = 0) And (FileName <> '');πend;ππ{=[ Comand Line Parameter Decode ]========================================}πFunction FindOutPutDevice : DeviceType;πVarπ Counter : Byte;π DeviceCounter : Byte;π Found : Boolean;π Device : DeviceType;πbeginπ Counter := 1;π Found := False;π Device := PcSpeaker;ππ While (Counter <= ParamCount) and Not(Found) doπ beginπ For DeviceCounter := 1 To MaxDevices doπ if UpString(ParamStr(Counter)) = DeviceCommand[DeviceCounter] Thenπ beginπ Device := DeviceType(DeviceCounter - 1);π Found := True;π end;ππ Inc(Counter);π end;ππ FindOutPutDevice := Device;πend;ππFunction FindRawFileName : String;πVarπ FileNameFound : String;π TempName : String;π Found : Boolean;π Counter : Byte;πbeginπ FileNameFound := '';π Counter := 1;π Found := False;ππ While (Counter <= ParamCount) and Not(Found) doπ beginπ TempName := UpString(ParamStr(Counter));π if TempName[1] <> '-' Thenπ beginπ FileNameFound := TempName;π Found := True;π end;π Inc (Counter);π end;ππ FindRawFileName := FileNameFound;πend;ππFunction FindPlayBackRate : Word;πVarπ RateString : String;π Rate : Word;π Found : Boolean;π Counter : Byte;π ErrorCode : Integer;πbeginπ Rate := 22000;π Counter := 1;π Found := False;ππ While (Counter <= ParamCount) and Not(Found) doπ beginπ RateString := UpString(ParamStr(Counter));π if Copy(RateString,1,2) = '-F' Thenπ beginπ RateString := Copy(RateString, 3, Length(RateString) - 2);π Val(RateString, Rate, ErrorCode);π if ErrorCode <> 0 Thenπ beginπ Rate := 22000;π Writeln ('Error In Frequency. Using Default');π end;π Found := True;π end;π Inc (Counter);π end;ππ if Rate < 18 Thenπ Rate := 18π elseπ if Rate > 44100 Thenπ Rate := 44100;ππ FindPlayBackRate := Rate;πend;ππFunction SignedSample : Boolean;πVarπ Found : Boolean;π Counter : Word;πbeginπ SignedSample := False;π Found := False;π Counter := 1;ππ While (Counter <= ParamCount) and Not(Found) doπ beginπ if UpString(ParamStr(Counter)) = '-S' Thenπ beginπ SignedSample := True;π Found := True;π end;ππ Inc(Counter);π end;πend;ππ{=[ Main Program ]========================================================}πVarπ SampleName : String;π SampleRate : Word;π OutDevice : DeviceType;πbeginπ Writeln;π Writeln('RAW Sound File Player V0.07');π Writeln('Programmed By David Dahl');π Writeln('Thanks to Emil Gilliam For Adlib digital output information');π Writeln('This Program is PUBLIC DOMAIN');ππ if ParamCount <> 0 Thenπ beginπ SampleRate := FindPlayBackRate;π SampleName := FindRawFileName;π OutDevice := FindOutPutDevice;π Writeln;ππ if SampleName <> '' Thenπ beginπ Writeln('Raw File : ',SampleName);π Writeln('Format : ',SignedUnsigned[SignedSample]);π Writeln('Sample Rate: ',SampleRate);π Writeln('Device : ',DeviceName[Ord(OutDevice)+1]);ππ if FileExists(SampleName) Thenπ beginπ SetOutputDevice(OutDevice, SignedSample);π PlayRAWSoundFile(SampleName, SampleRate);π endπ elseπ Writeln('Sound File Not Found.');π endπ elseπ Writeln('Filename Not Specified.');π endπ elseπ beginπ Writeln;π Writeln('USAGE:');π Writeln(ParamStr(0),' [SWITCHES] <RAW DATA File>');π Writeln;π Writeln('SWITCHES:');π Writeln(' -P PC Speaker, Polled (Default)');π Writeln(' -L1 LPT DAC on LPT 1');π Writeln(' -L2 LPT DAC on LPT 2');π Writeln(' -L3 LPT DAC on LPT 3');π Writeln(' -L4 LPT DAC on LPT 4');π Writeln(' -A Adlib/Sound Blaster FM');π Writeln;π Writeln(' -S Signed Sample (Unsigned Default)');π Writeln;π Writeln(' -FXXXXX Frequency Of Sample. XXXXX can be any Integer ',π 'between 18 to 44100');π Writeln (' (22000 Default)');π end;ππ CleanUp;πend.πππ 28 08-27-9321:41ALL JOERGEN DORCH Sounds In Pascal IMPORT 6 ■" {πJOERGEN DORCHππ About Sounds i Pascal - Here's how I do it:π}ππFunction Frequency(Octave, NoteNum : Integer) : Integer;πConstπ Silence = 32767;πVarπ Oct : Integer;ππ Function Power(X, Y : Real) : Real;π beginπ Power := Exp(Y * Ln(X));π end;ππbeginπ Oct := Octave - 3;π if NoteNum > 0 thenπ Frequency := Round(440 * Power(2, Oct + ((NoteNum - 10) / 12)))π elseπ Frequency := Silence;πend;ππ{πWhere Octave is in the range [0..6] and NoteNum in the range [1..12],πthat is C = 1, C# = 2, D = 3 etc.π} 29 08-27-9321:44ALL SEAN PALMER Controling the PC SpeakerIMPORT 13 ■" {πSEAN PALMERππ>I have TP 6.0, and I'am looking For a way to address my PC Speaker. I don'tπ>know what Port it is (like PORT[$30] or something), or how to send raw Soundπ>data to it. Could someone help me?ππTry this, or actually a Variation on it. Doing VOC's and WAV's on a pcπspeaker is not an easy task...ππWhat you're looking For is embedded in the 'click' Procedure below...ππ'click' only works While no tone is being produced. click at differentπrates to get different pitches/effects.ππso I guess the simple answer to your question is that it's controlled byπbit 1 (from 0 to 7) of port $61.π}ππUnit uTone;πInterfaceππProcedure tone(freq : Word);πProcedure noTone;πProcedure click;ππImplementationππConstπ sCntrl = $61; { Sound control port }π SoundOn = $03; { bit mask to enable speaker }π SoundOff = $FC; { bit mask to disable speaker }π C8253 = $43; { port address to control 8253 }π seTimer = $B6; { tell 8253 to expect freq data next }π F8253 = $42; { frequency address on 8253 }ππProcedure tone(freq : Word); Assembler;πAsmπ mov al, $B6π out $43, al {Write timer mode register}π mov dx, $14π mov ax, $4F38π div freq {1331000/Frequency pulse}π out $42, alπ mov al, ahπ out $42, al {Write timer a Byte at a time}π in al, $61π or al, 3π out $61, al {port B-switch speaker on}πend;ππProcedure noTone; Assembler;πAsmπ in al, $61π and al, $FCπ out $61, alπend;ππProcedure click; Assembler;πAsmπ in al, $61π xor al, 2π out $61, alπend;ππend.π 30 08-27-9321:52ALL BRIAN PAPE Play with Soundblaster IMPORT 28 ■" {πBRIAN PAPEππOk, here's about 45 minutes of sweating, trying to read some pitifull SBπreference. This is about as far as I've gotten trying to make the SBπmake some noise that is actually a note, not just a buzz... If anyoneπcan do ANYTHING at ALL with this, please tell me.ππThis program is not Copyright (c)1993 by Brian Pape.πwritten 4/13/93πIt is 100% my code with nothing taken from anyone else. If you can use it inπanyway, great. I should have the actual real version done later this summerπthat is more readable. The .MOD player is about half done, pending theπfinishing of the code to actually play the notes (decoder is done).πMy fido address is 1:2250/26π}πprogram sb;πusesπ crt;πconstπ on = true;π off = false;π maxreg = $F5;π maxch = 10;ππ note_table : array [0..12] of word =π ($000,$16b,$181,$198,$1b0,$1ca,$1e5,$202,$220,$241,$263,$287,$2ae);π key_table : array [1..12] of char =π 'QWERTYUIOP[]';π voicekey_table : array [1..11] of char =π '0123456789';πtypeπ byteset = set of byte;ππvarπ ch : char;π channel : byte;π ch_active : byteset;π lastnote : array [0..maxch] of word;πππprocedure writeaddr(b : byte); assembler;πasmπ mov al, bπ mov dx, 388hπ out dx, alπ mov cx, 6ππ @wait:π in al, dxπ loop @waitπend;ππprocedure writedata(b : byte); assembler;πasmπ mov al, bπ mov dx, 389hπ out dx, alπ mov cx, 35hπ dec dxππ @wait:π in al, dxπ loop @waitπend;ππprocedure sb_reset;πvarπ i : byte;πbeginπ for i := 1 to maxreg doπ beginπ writeaddr(i);π writedata(0);π end;πend;ππprocedure sb_off;πbeginπ writeaddr($b0);π writedata($11);πend;ππ{ r=register,d=data }πprocedure sb_out(r, d : byte);πbeginπ writeaddr(r);π writedata(d);πend;ππprocedure sb_setup;πbeginπ sb_out($20, $01);π sb_out($40, $10);π sb_out($60, $F0);π sb_out($80, $77);π sb_out($A0, $98);π sb_out($23, $01);π sb_out($43, $00);π sb_out($63, $F0);π sb_out($83, $77);π sb_out($B0, $31);πend;ππprocedure disphelp;πbeginπ clrscr;π writeln;π writeln('Q:C#');π writeln('W:D');π writeln('E:D#');π writeln('R:E');π writeln('T:F');π writeln('Y:F#');π writeln('U:G');π writeln('I:G#');π writeln('O:A');π writeln('P:A#');π writeln('[:B');π writeln(']:C');π writeln('X:Quit');π writeln;πend;ππprocedure sb_note(channel : byte; note : word; on : boolean);πbeginπ sb_out($a0 + channel, lo(note));π sb_out($b0 + channel, ($20 * byte(on)) or $10 or hi(note));πend;ππprocedure updatestatus;πvarπ i : byte;πbeginπ gotoxy(1,16);π for i := 0 to maxch doπ beginπ if i in ch_active thenπ textcolor(14)π elseπ textcolor(7);π write(i : 3);π end;πend;ππbeginπ sb_reset;π sb_out(1, $10);π sb_setup;π disphelp;π channel := 0;π ch_active := [0];π repeatπ updatestatus;π ch := upcase(readkey);π if pos(ch, key_table) <> 0 thenπ beginπ lastnote[channel] := note_table[pos(ch, key_table)];π sb_note(channel, lastnote[channel], on);π endπ elseπ if pos(ch, voicekey_table) <> 0 thenπ beginπ channel := pred(pos(ch,voicekey_table));π if channel in ch_active thenπ ch_active := ch_active - [channel]π elseπ ch_active := ch_active + [channel];π if not (channel in ch_active) thenπ sb_note(channel,lastnote[channel],off)π elseπ sb_note(channel,lastnote[channel],on);π end;π until ch = 'X';π sb_off;πend.ππ 31 08-27-9321:53ALL NORBERT IGL Direct output to SB Card IMPORT 22 ■" {πNORBERT IGLππ>> if you already have the DAC Programming, simply Write out eachπ>> Byte to the DAC PORT (Write $10, then the data For Direct Mode)π>> Then Delay after each Byte, depending on the Sampling rate.π>> You'll have to play around With the Delay's.ππ Just found a piece of source in my Files.... (:-)),π but i don't know the original author ( RedFox ? )π and i translated the (orig.) german remarks....π}ππUsesπ Crt;πConstπ ResetPort = $226;π ReadPort = $22A;π WritePort = $22C;π StatusPort = $22C;π DataDaPort = $22E;ππ { N.I.: Note: Use SB_Port (prev. Msg) to get the correct address.... }ππ AD_Null = $80;π OK = 0000;π NichtGefunden = 1000;π DirectDAC = $10;π SpeakerOn = $D1;π SpeakerOff = $D3;ππVarπ DSPResult : Word;π DSPReadWert : Byte;ππ loop : Word;π w : Word;π m : Word;πππProcedure WriteToDSP(Command : Byte);πbeginπ Repeat Until (port[StatusPort] and $80) = 0;π port[WritePort] := Command;πend;ππProcedure ReadFromDSP;πbeginπ Repeat Until (port[DataDaPort] and $80) = $80;π DSPReadWert := port[ReadPort];πend;ππProcedure ResetDSP;πVarπ MaxVersuch : Byte;πbeginπ MaxVersuch:=100;π Repeatπ port[ResetPort] := 1;π Delay(10);π port[ResetPort] := 0;π ReadFromDSP;π dec(MaxVersuch);π Until (DSPReadWert = $AA) or (MaxVersuch = 0);ππ if MaxVersuch = 0 thenπ DSPResult := NichtGefundenπ elseπ DSPResult := OK;πend;πππbeginπ ClrScr;ππ ResetDSP;ππ if DSPResult <> OK thenπ beginπ Writeln(' Soundeblaster not found !');π Writeln(' Wrong SB-address ?');π endπ elseπ beginπ Writeln(' Demo : direct output to the SoundblasterCard !');π Writeln(' ┌──┐ ┌──┐ ┌──┐ ┌──┐ ┌──┐ ┌ creates a square');π Writeln(' │ │ │ │ │ │ │ │ │ │ │ waveform With an');π Writeln('──┘ └──┘ └──┘ └──┘ └──┘ └──┘ 64`er amplitude ');π Writeln;π Writeln(' RedFox (14.11.91) ');ππ WriteToDSP(SpeakerOn); { Speaker on }ππ m := 5000; { dynamc Wait (Init) }ππ For loop := 1 to 600 do { 600 samples }π beginπ dec(m, 10);π if m < 20 thenπ m := 500;π WriteToDSP(DirectDAC); { command to SB }π WriteToDSP(AD_Null + 32); { now the sample }ππ { rising edge }π For w := 1 to m do begin end; { dynamc wait }ππ WriteToDSP(DirectDAC); { command to SB }π WriteToDSP(AD_Null - 32); { falling edge }ππ For w := 1 to m do begin end; { wait again }π end;π WriteToDSP(SpeakerOff); { speaker off }π end;πend.π 32 09-26-9309:19ALL CATHY NICOLOFF Adlib/SB Music SWAG9311 43 ■" (*π===========================================================================π BBS: Canada Remote SystemsπDate: 09-02-93 (00:16) Number: 36877πFrom: CATHY NICOLOFF Refer#: NONEπ To: ALL Recvd: NOπSubj: Musical Notes!!! 1/2 Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πHere's some help for all you programmers out there! It's straight fromπmy personal programming library!πππSBNotes : Array[1..12] Of Byte =π ($AE, $6B, $81, $98, $B0, $CA, $E5, $02, $20, $41, $63, $87);ππ SBOctaves : Array[1..84] Of Byte =π ($22, $25, $25, $25, $25, $25, $25, $26, $26, $26, $26, $26,π $26, $29, $29, $29, $29, $29, $29, $2A, $2A, $2A, $2A, $2A,π $2A, $2D, $2D, $2D, $2D, $2D, $2D, $2E, $2E, $2E, $2E, $2E,π $2E, $31, $31, $31, $31, $31, $31, $32, $32, $32, $32, $32,π $32, $35, $35, $35, $35, $35, $35, $36, $36, $36, $36, $36,π $36, $39, $39, $39, $39, $39, $39, $3A, $3A, $3A, $3A, $3A,π $3A, $3D, $3D, $3D, $3D, $3D, $3D, $3E, $3E, $3E, $3E, $3E);ππ Notes : Array[1..84] Of Word =π { C C#,D- D D#,E- E F F#,G- G G#,A- A A#,B- B }π (0065, 0070, 0073, 0078, 0082, 0087, 0093, 0098, 0104, 0110, 0117, 0123,π 0131, 0139, 0147, 0156, 0165, 0175, 0185, 0196, 0208, 0220, 0233, 0247,π 0262, 0277, 0294, 0311, 0330, 0349, 0370, 0392, 0415, 0440, 0466, 0494,π 0523, 0554, 0587, 0622, 0659, 0698, 0740, 0784, 0831, 0880, 0932, 0987,π 1047, 1109, 1175, 1245, 1329, 1397, 1480, 1568, 1661, 1760, 1865, 1976,π 2093, 2217, 2349, 2489, 2637, 2794, 2960, 3136, 3322, 3520, 3729, 3951,π 4186, 4435, 4699, 4978, 5274, 5588, 5920, 6272, 6645, 7040, 7459, 7902);ππExplanation : This is used to emulate single note music (IE-ANSI music).ππThe array NOTES is the frequencies used to do a SOUND/NOSOUND on the PCπspeaker.ππThe SBNOTES and SBOCTAVES arrays are the hex values of the notes, andπtheir octaves for any ADLIB compatible card.ππJust take which note you want, and input the note AND the octaveπinto the Adlib port. Here's some sample code to show you how :π*)ππUnit Music;ππInterfaceππUses Crt;ππCONSTππSBNotes : Array[1..12] Of Byte =π ($AE, $6B, $81, $98, $B0, $CA, $E5, $02, $20, $41, $63, $87);ππ SBOctaves : Array[1..84] Of Byte =π ($22, $25, $25, $25, $25, $25, $25, $26, $26, $26, $26, $26,π $26, $29, $29, $29, $29, $29, $29, $2A, $2A, $2A, $2A, $2A,π $2A, $2D, $2D, $2D, $2D, $2D, $2D, $2E, $2E, $2E, $2E, $2E,π $2E, $31, $31, $31, $31, $31, $31, $32, $32, $32, $32, $32,π $32, $35, $35, $35, $35, $35, $35, $36, $36, $36, $36, $36,π $36, $39, $39, $39, $39, $39, $39, $3A, $3A, $3A, $3A, $3A,π $3A, $3D, $3D, $3D, $3D, $3D, $3D, $3E, $3E, $3E, $3E, $3E);ππ Notes : Array[1..84] Of Word =π { C C#,D- D D#,E- E F F#,G- G G#,A- A A#,B- B }π (0065, 0070, 0073, 0078, 0082, 0087, 0093, 0098, 0104, 0110, 0117, 0123,π 0131, 0139, 0147, 0156, 0165, 0175, 0185, 0196, 0208, 0220, 0233, 0247,π 0262, 0277, 0294, 0311, 0330, 0349, 0370, 0392, 0415, 0440, 0466, 0494,π 0523, 0554, 0587, 0622, 0659, 0698, 0740, 0784, 0831, 0880, 0932, 0987,π 1047, 1109, 1175, 1245, 1329, 1397, 1480, 1568, 1661, 1760, 1865, 1976,π 2093, 2217, 2349, 2489, 2637, 2794, 2960, 3136, 3322, 3520, 3729, 3951,π 4186, 4435, 4699, 4978, 5274, 5588, 5920, 6272, 6645, 7040, 7459, 7902);ππProcedure Play_SB(N, M : Byte);πProcedure Init_SB;πProcedure Reset_SB;πFunction Detect_SB : Boolean;ππImplementationππ(***********************)ππProcedure Play_SB(N, M : Byte);ππVar Loop : Integer;π Temp : Integer;ππBeginπ Port[$0388] := N;π For Loop := 1 To 6 Doπ Temp := Port[$0388];π Port[$0389] := M;π For Loop:=1 To 35 Doπ Temp := Port[$0388];πEnd;ππ(***********************)ππProcedure Init_SB;ππVarπ A : Integer;ππBeginπ For A := 1 to 244 Doπ Play_SB(A,$00);π Play_SB($01,32);π Play_SB($B0,$11);π Play_SB($04,$60);π Play_SB($04,$80);πEnd;ππ(***********************)ππProcedure Reset_SB;ππBeginπ Play_SB($20,$41);π Play_SB($40,$10);π Play_SB($60,$F0);π Play_SB($80,$77);π Play_SB($23,$41);π Play_SB($43,$00);π Play_SB($63,$F0);π Play_SB($83,$77);π Play_SB($BD,$10);πEnd;ππ(***********************)πππFunction Detect_SB : Boolean;ππVarπ Dummy1,π Dummy2 : Byte;ππBeginπ Play_SB($04,$60);π Play_SB($04,$80);π Dummy1 := Port[$388];π Play_SB($02,$FF);π Play_SB($04,$21);π Delay(8);π Dummy2 := Port[$388];π Play_SB($04,$60);π Play_SB($04,$80);π If ((Dummy1 AND $E0) = $00) And ((Dummy2 AND $E0) = $C0) Thenπ Detect_SB := Trueπ Elseπ Detect_SB := False;πEnd;ππ(***********************)ππEnd.ππThat is my own soundblaster unit I use to output.ππTo play note 'C' at octave 3, do the following :ππPlay_SB($A0, SBNotes[1]);πPlay_SB($B0, SBOctaves[1 + 3 * 12]);ππTo shut off Adlib output, do this :ππPlay_SB($83, $FF);πPlay_SB($B0, $11);ππ{ TEST PROGRAM }ππUses DOS,Crt,Music;ππVAR I : BYTE;ππBEGINπInit_SB;πReset_SB;πFOR I := 1 To 8 DOπ BEGINπ Play_SB($A0, SBNotes[i]);π Play_SB($B0, SBOctaves[i + 3 * 12]);π DELAY(500);π END;πInit_SB;πReset_SB;πEND.πππππ 33 11-02-9307:50ALL EDWARD SCHLUNDER Format for WAV Files SWAG9311 33 ■" {πEDWARD SCHLUNDERππ> Hey everyone.. I am requesting some info on the File format of MODπ> Files and also WAV Files. I would Really appreciate any help on this topic.ππWell, the MOD File format has been posted over the place many times, so Iπwon't post THAT again. But here comes the WAV File format that you wanted..ππ WAV File Format. Written by Edward Schlunder.π Information from Tony Cookππ Byte(S) NORMAL CONTENTS PURPOSE/DESCRIPTIONπ ---------------------------------------------------------------------------ππ 00 - 03 "RIFF" Just an identification block.π The quotes are not included.ππ 04 - 07 ??? This is a long Integer. Itπ tells the number of Bytes longπ the File is, includes header,π not just the Sound data.ππ 08 - 11 "WAVE" Just an other I.D. thing.ππ 12 - 15 "fmt " Just an other I.D. thing.ππ 16 - 19 16, 0, 0, 0 Size of header to this point.ππ 20 - 21 1, 0 Format tag. I'm not sure whatπ 'Format tag' means, but Iπ believe it has something toπ do With how the File isπ formated, so that if someoneπ wants to change the Fileπ format to include somethingπ new, they could also changeπ this to show that it's aπ different format.ππ 22 - 23 1, 0 Channels. Channels is how manyπ Sounds to be played at once.π Sound Blasters have only oneπ channel, and this is probablyπ why this is normally set to 1.π The Amiga has 4 (hence 4π channel MODs) channels. Theπ Gravis Ultra Sound has manyπ more, I believe up to 32.ππ 24 - 27 ??? Sampling rate, or (in otherπ Words), samples per second.π This is used to determineπ how fast to play the WAV. Itπ is also essentially the sameπ as Bytes 28-31.ππ 28 - 31 ??? Average Bytes per second.ππ 32 - 33 1, 0 Block align.ππ 34 - 35 8, 0 Bits per sample. Ex: Soundπ Blaster can only do 8, Soundπ Blaster 16 can make 16.π Normally, the only valid valuesπ are 8, 12, and 16.ππ 36 - 39 "data" Marker that comes just beforeπ the actual sample data.ππ 40 - 43 ??? The number of Bytes in theπ sample.ππ There, I hope you like it.. if you ever have any needs For Soundπ card or just Sound related Programming information, give me a *bang*π and I'll run... I might be late replying, but I will get back to you.π}π 34 11-02-9318:38ALL LENNERT BAKKER DETECTS SoundBlaster SWAG9311 22 ■" {πFrom: LENNERT BAKKERπSubj: SB AutoDetectπ Here's how to autodetect a soundblaster and it's baseaddressπ and some other support-stuff for your convenience: }πππ{ Hey let's check this SB out 8-)}ππConst SBReset = $6;π SBRead = $A;π SBWrite = $C;π SBStatus = $E;ππVar SBPort : Word;π SBInstalled : Boolean;ππProcedure DetectSoundBlaster;πConst NrTimes = 10;π NrTimes2 = 50;πVar Found : Boolean;π Counter1,Counter2 : Word;πBeginπ SBPort:=$210;π Found:=False;π Counter1:=NrTimes;π While (SBPort<=$260) And Not Found Doπ Beginπ Port[SBPort+$6]:=1;π Port[SBPort+$6]:=0;π Counter2:=NrTimes2;π While (Counter2>0) And (Port[SBPort+$E]<128) Doπ Dec(Counter2);π If (Counter2=0) Or (Port[SBPort+$A]<>$AA) Thenπ Beginπ Dec(Counter1);π If (Counter1=0) Thenπ Beginπ Counter1:=NrTimes;π SBPort:=SBPort+$10;π Endπ End Else Found:=True;π End;π If Found then SBInstalled:=Trueπ Else SBInstalled:=False;πEnd;ππBeginπ DetectSoundBlaster;π If SBInstalled thenπ Writeln('SoundBlaster found at port :', SBPort)π elseπ Writeln('No soundcard, no boogie!');πEnd.πππ{Here's how to initialize the DSP:}ππProcedure SetupSoundBlaster;πVar I,BDum : Byte;πBeginπ If SBInstalled thenπ Beginπ Port[SBPort+SBReset]:=1; {Reset DSP}π For I:=1 to 6 doπ BDum:=Port[SBPort+SBStatus];π Port[SBPort+SBReset]:=0;π For I:=1 to 6 doπ BDum:=Port[SBPort+SBStatus];π Repeat Until Port[SBPort+SBStatus]>$80;π End;πEnd;ππ{Respectively turn the speaker on/off}ππProcedure TurnOnSBSpeaker;πBeginπ Repeat Until Port[SBPort+SBWrite]<$80;π Port[SBPort+SBWrite]:=$D1;πEnd;ππProcedure TurnOffSBSpeaker;πBeginπ Repeat Until Port[SBPort+SBWrite]<$80;π Port[SBPort+SBWrite]:=$D3;πEnd;ππ{π Here's basically how you play a sample, you should reprogramπ the timer though and have your interrupt routine output bytesπ to the DSP at regular intervals, say 10000 times/sec or so.π Rather use machine-language instead, but that shouldn't be tooπ hard now, should it? 8)π}ππProcedure PlaySample(Sample:Pointer;Length:Word);πVar A : Word;πBeginπ For A:=1 to Length Doπ Beginπ Port[SBPort+SBWrite]:=$10;π Port[SBPort+SBWrite]:=Mem[Seg(Sample^):Ofs(Sample^)+A];π {Delay some time}π End;πEnd;ππ{Or sumtin like this (untested) }ππProcedure PlaySampleASM(Sample:Pointer;Length:Word); Assembler;πAsmπ Les Di,[Sample]π Mov Dx,SBPort+SBWriteπ Mov Cx,Lengthπ@LoopIt:π LodsBπ Out Dx,$10π Out Dx,Alππ { Delay Some Time -- What about 1000 NOPs or so ;-) }ππ Loop @LoopItπEnd;ππ 35 11-02-9306:13ALL RYNHARDT HAARHOFF Sampling with Blaster SWAG9311 33 ■" {πRYNHARDT HAARHOFFππ> Help!!! Does anyone have and source code for sampling through theπ> Sound Blaster??? Its to do with my 'A' Level Project!!!!ππthe following is a small program using "realtime" sampling. If you wouldπrather use the CT-VOICE driver then please tell me so.ππPLEASE NOTE: this was written for a VGA screen, and it uses direct videoπmemory access in 320x200 mode. If you have any problems with the screen, thenπrevert back to the BGI, and replace PutDot with PutPixel. It will be slightlyπslower then :-(πI have an SB PRO, so I can't guarantee it will work on any other SB, orπon any other system. Use at own risk :-)π}ππProgram VoiceScope;ππusesπ Crt;ππconstπ ResetPort = $226;π CommandPort = $22C;π ReadPort = $22A;π PollPort = $22E;π MaxOldDots = 50000; {max size of the array}π MixerRegPort = $224; {Volume : Hi nibble = left, Lo Nibble = right}π MixerDatPort = $225;π Master = 35;π Line = 46;π VOC = 21;π FM = 23; {Hi nibble = FM channel; Lo nibble = volume}π CD = 25;π Mic = 27;π ADCChannel = 29;π StereoSell = 31; {0,1 = mono; 2,3 = stereo}πππvarπ Scr : array [0..199, 0..319] of byte absolute $A000:0000;π Ch : char;π XInt,π XWidth,π XMax,π YMax,π XMid,π YMid,π MaxHeight,π XStart,π Color,π ColorBack : integer;π OldDots : array [0..MaxOldDots] of byte; {to store old dots}πππProcedure InitVideo(Mode : byte; Clr : boolean);πbeginπ if NOT Clr thenπ Mode := Mode + 128;π ASMπ mov AH, 00π mov AL, Modeπ int 10hπ end;πend;ππProcedure PutDot(x, y : word; Color : byte);πbeginπ Scr[y, x] := Color;πend;ππProcedure SquareFill(x1, y1, x2, y2 : word; Color : byte);πvarπ y : word;πbeginπ for y := y1 to y2 doπ FillChar(Scr[y, x1], x2-x1, Color);πend;ππProcedure SetMixer(PortNum, Vol : byte); {Set mixer ports}πbeginπ asmπ MOV DX, MixerRegPort {Select register port}π MOV AL, PortNum {Select which channel}π OUT DX, ALπ MOV DX, MixerDatPort {Select data port}π MOV AL, Vol {Write volume/data}π OUT DX, ALπ end;πend;ππFunction ResetSB : boolean; {resets the SB}πbeginπ Port[ResetPort] := 1;π Delay(1);π Port[ResetPort] := 0;π Delay(1);π if Port[PollPort] and 128 = 128 thenπ ResetSB := Trueπ elseπ ResetSB := False;πend;ππProcedure ShowDots(D : integer); {show the voice data}πvarπ x, y : word;π NewX : word;πbeginπ for x := 1 to XWidth * d doπ beginπ port[CommandPort] := $20; { these three lines }π repeat until (port[PollPort] and 128 = 128); { gets the actual }π y := port[ReadPort]; { data from the SB }ππ if y > 128 + MaxHeight thenπ y := 128 + MaxHeight;π if y < 128 - MaxHeight thenπ y := 128 - MaxHeight;ππ NewX := x div d;π PutDot(NewX + XStart, OldDots[x] + YMid - 128, ColorBack);π PutDot(NewX + XStart, y + YMid - 128, y div 2);π OldDots[x] := y;π end;π if keypressed thenπ begin {pause}π Ch := ReadKey;π if Ch = #32 thenπ repeat until keypressed;π end;πend;ππProcedure Init; {initialize all the variables}πvarπ N : longint;πbeginπ InitVideo($13, TRUE);π Ch := #0;π XMax := 319;π XMid := XMax div 2;π YMax := 199;π YMid := YMax div 2;π XInt := 10;π XWidth := 280;π XStart := XMid - XWidth div 2;π MaxHeight := 60;π Color := 9;π ColorBack := 0;π SquareFill(XStart-10, YMid-MaxHeight-1-10, XStart+XWidth+1+10, YMid+MaxHeight+1+10, 10);π SquareFill(XStart, YMid-MaxHeight-1, XStart+XWidth+1, YMid+MaxHeight+1, ColorBack);π for N := 0 to MaxOldDots doπ OldDots[N] := 128;π if ResetSb then;πend;ππBEGINπ Init;π SetMixer(ADCChannel, 1); {Sets the ADC channel to MIC}ππ {NOTE: I don't know if the mixer routines will work on any otherπ SB. If something stalls, then exclude the mixer statementsπ If you want to use the LINE-IN, then SetMixer(ADCChannel, 6);}ππ While Ch <> #27 do ShowDots(1); {This value is a time constant}πEND.π 36 10-28-9311:38ALL WIM VAN.VOLLENHOVEN SOUND Machine SWAG9311 79 ■" {===========================================================================πDate: 08-31-93 (22:24)πFrom: WIM VAN.VOLLENHOVENπSubj: Sound Moduleπ---------------------------------------------------------------------------πWell.. here is the source code i've found in a pascal toolbox (ECO)πwhich emulates the play function of qbasic :-)ππ{π call: play(string)ππ music_string --- the string containing the encoded music to beπ played. the format is the same as that of theπ microsoft basic play statement. the stringπ must be <= 254 characters in length.ππ calls: soundπ getint (internal)ππ remarks: the characters accepted by this routine are:ππ a - g musical notesπ # or + following a - g note, indicates sharpπ - following a - g note, indicates flatπ < move down one octaveπ > move up one octaveπ . dot previous note (extend note duration by 3/2)π mn normal duration (7/8 of interval between notes)π ms staccato durationπ ml legato durationπ ln length of note (n=1-64; 1=whole note,4=quarter note)π pn pause length (same n values as ln above)π tn tempo,n=notes/minute (n=32-255,default n=120)π on octave number (n=0-6,default n=4)π nn play note number n (n=0-84)ππ the following two commands are ignored by play:ππ mf complete note before continuingπ mb another process may begin before speaker isπ finished playing noteππ important --- setdefaultnotes must have been called at least once beforeπ this routine is called.π}ππunit u_play;πinterfaceππusesπ crtππ ;ππconstπ note_octave : integer = 4; { current octave for note }π note_fraction : real = 0.875; { fraction of duration given to note }π note_duration : integer = 0; { duration of note ^^semi-legato }π note_length : real = 0.25; { length of note }π note_quarter : real = 500.0; { moderato pace (principal beat) }ππππ procedure quitsound;π procedure startsound;π procedure errorbeep;π procedure warningbeep;π procedure smallbeep;π procedure setdefaultnotes;π procedure play(s: string);π procedure beep(h, l: word);ππππimplementationπππππ procedure quitsound;π var i: word;π beginπ for i := 100 downto 1 do begin sound(i*10); delay(2) end;π for i := 1 to 800 do begin sound(i*10); delay(2) end;π nosound;π end;ππ procedure startsound;π var i: word;π beginπ for i := 100 downto 1 do begin sound(i*15); delay(2) end;π for i := 1 to 100 do begin sound(i*15); delay(2) end; nosound;π delay(100); for i := 100 downto 1 do begin sound(i*10); delay(2) end;π nosound;π end;πππ procedure errorbeep;π beginπ sound(2000); delay(75); sound(1000); delay(75); nosound;π end;πππ procedure warningbeep;π beginπ sound(500); delay(500); nosound;π end;ππ procedure smallbeep;π beginπ sound(300); delay(50); nosound;π end;ππππππprocedure setdefaultnotes;πbeginπ note_octave := 4; { default octave }π note_fraction := 0.875; { default sustain is semi-legato }π note_length := 0.25; { note is quarter note by default }π note_quarter := 500.0; { moderato pace by default }πend;ππππprocedure play(s: string);πconstπ { offsets in octave of natural notes }π note_offset : array[ 'A'..'G' ] of integer = (9,11,0,2,4,5,7);ππ { frequencies for 7 octaves }π note_freqs: array[ 0 .. 84 ] of integer =π{π c c# d d# e f f# g g# a a# bπ}π( 0,π 65, 69, 73, 78, 82, 87, 92, 98, 104, 110, 116, 123,π 131, 139, 147, 156, 165, 175, 185, 196, 208, 220, 233, 247,π 262, 278, 294, 312, 330, 350, 370, 392, 416, 440, 466, 494,π 524, 556, 588, 624, 660, 700, 740, 784, 832, 880, 932, 988,π 1048,1112,1176,1248,1320,1400,1480,1568,1664,1760,1864,1976,π 2096,2224,2352,2496,2640,2800,2960,3136,3328,3520,3728,3952,π 4192,4448,4704,4992,5280,5600,5920,6272,6656,7040,7456,7904 );ππ quarter_note = 0.25; { length of a quarter note }ππ digits : set of '0'..'9' = ['0'..'9'];ππvarππ play_freq : integer; { frequency of note to be played }π play_duration : integer; { duration to sound note }π rest_duration : integer; { duration of rest after a note }π i : integer; { offset in music string }π c : char; { current character in music string }π { note frequencies }π freq : array[0..6,0..11] of integer absolute note_freqs;π n : integer;π xn : real;π k : integer;ππ function getint : integer;π var n: integer;ππ begin { getint }π n := 0;π while(s[i] in digits) do begin n := n*10+ord(s[i])-ord('0'); inc(i) end;π dec(i); getint := n;π end { getint };ππbeginπ s := s + ' '; { append blank to end of music string }π i := 1; { point to first character in music }π while(i < length(s)) do begin { begin loop over music string }π c := upcase(s[i]); { get next character in music string }π case c of { interpret it }π 'A'..'G' : begin { a note }π n := note_offset[ c ];π play_freq := freq[ note_octave ,n ];π xn := note_quarter * (note_length / quarter_note);π play_duration := trunc(xn * note_fraction);π rest_duration := trunc(xn * (1.0 - note_fraction));π { check for sharp/flat }π if s[i+1] in ['#','+','-' ] thenπ beginπ inc(i);π case s[i] ofπ '#',π '+' : play_freq :=π freq[ note_octave ,succ(n) ];π '-' : play_freq :=π freq[ note_octave ,pred(n) ];π else ;π end { case };ππ end;ππ { check for note length }ππ if (s[i+1] in digits) thenπ beginππ inc(i);π n := getint;π xn := (1.0 / n) / quarter_note;ππ play_duration :=π trunc(note_fraction * note_quarter * xn);ππ rest_duration :=π trunc((1.0 - note_fraction) *π xn * note_quarter);ππ end;π { check for dotting }ππ if s[i+1] = '.' thenπ beginππ xn := 1.0;ππ while(s[i+1] = '.') doπ beginπ xn := xn * 1.5;π inc(i);π end;ππ play_duration :=π trunc(play_duration * xn);ππ end;ππ { play the note }ππ sound(play_freq);π delay(play_duration);π nosound;π delay(rest_duration);π end { a note };ππ 'M' : begin { 'M' commands }π inc(i);π c := s[i];π case c ofπ 'F' : ;π 'B' : ;π 'N' : note_fraction := 0.875;π 'L' : note_fraction := 1.000;π 'S' : note_fraction := 0.750;π else ;π end { case };π end { 'M' commands };ππ 'O' : begin { set octave }π inc(i);π n := ord(s[i]) - ord('0');π if (n < 0) or (n > 6) then n := 4;π note_octave := n;π end { set octave };ππ '<' : begin { drop an octave }π if note_octave > 0 then dec(note_octave);π end { drop an octave };ππ '>' : begin { ascend an octave }π if note_octave < 6 then inc(note_octave);π end { ascend an octave };ππ 'N' : begin { play note n }π inc(i); n := getint;π if (n > 0) and (n <= 84) then beginπ play_freq := note_freqs[ n ];π xn := note_quarter * (note_length / quarter_note);π play_duration := trunc(xn * note_fraction);π rest_duration := trunc(xn * (1.0 - note_fraction));π end else if (n = 0) then beginπ play_freq := 0; play_duration := 0;π rest_duration := trunc(note_fraction * note_quarter *π (note_length / quarter_note));π end;π sound(play_freq); delay(play_duration); nosound;π delay(rest_duration);π end { play note n };π 'L' : begin { set length of notes }π inc(i); n := getint;π if n > 0 then note_length := 1.0 / n;π end { set length of notes };ππ 'T' : begin { # of quarter notes in a minute }π inc(i); n := getint;π note_quarter := (1092.0 / 18.2 / n) * 1000.0;π end { # of quarter notes in a minute };ππ 'P' : begin { pause }π inc(i); n := getint;π if (n < 1) then n := 1 else if (n > 64) then n := 64;π play_freq := 0; play_duration := 0;π rest_duration := trunc(((1.0 / n) / quarter_note) * note_quarter);π sound(play_freq); delay(play_duration); nosound;π delay(rest_duration);π end { pause };ππ else { ignore other stuff };π end { case };π inc(i);π end { interpret music };π nosound; { make sure sound turned off when through }πend;πππprocedure beep(h, l: word);πbeginπ sound(h); delay(l); nosound;πend;ππend. { of unit }π
